home *** CD-ROM | disk | FTP | other *** search
/ C/C++ Interactive Reference Guide / C-C++ Interactive Reference Guide.iso / c_ref / csource3 / 117_01 / ratfor.ftn < prev    next >
Encoding:
Text File  |  1985-03-11  |  77.8 KB  |  3,051 lines
  1. C RATFOR BOOTSTRAP (IN FORTRAN)
  2. C
  3.       CALL INITST
  4.       CALL RAT4
  5.       CALL ENDST
  6.       END
  7.       SUBROUTINE BRKNXT(SP, LEXTYP, LABVAL, TOKEN)
  8.       INTEGER LABVAL(100), LEXTYP(100), SP, TOKEN
  9.       INTEGER I, N, ALLDIG, CTOI
  10.       INTEGER T, PTOKEN(100), GNBTOK
  11.       COMMON /CGOTO/ XFER
  12.       INTEGER XFER
  13.       N = 0
  14.       T = GNBTOK(PTOKEN, 100)
  15.       IF(.NOT.(ALLDIG(PTOKEN) .EQ. 1))GOTO 23000
  16.       I = 1
  17.       N = CTOI(PTOKEN, I) - 1
  18.       GOTO 23001
  19. 23000 CONTINUE
  20.       IF(.NOT.(T .NE. 59))GOTO 23002
  21.       CALL PBSTR(PTOKEN)
  22. 23002 CONTINUE
  23. 23001 CONTINUE
  24.       I = SP
  25. 23004 IF(.NOT.(I .GT. 0))GOTO 23006
  26.       IF(.NOT.(LEXTYP(I) .EQ. 10263 .OR. LEXTYP(I) .EQ. 10266 .OR. LEXTY
  27.      *P(I) .EQ. 10268 .OR. LEXTYP(I) .EQ. 10269))GOTO 23007
  28.       IF(.NOT.(N .GT. 0))GOTO 23009
  29.       N = N - 1
  30.       GOTO 23005
  31. 23009 CONTINUE
  32.       IF(.NOT.(TOKEN .EQ. 10264))GOTO 23011
  33.       CALL OUTGO(LABVAL(I)+1)
  34.       GOTO 23012
  35. 23011 CONTINUE
  36.       CALL OUTGO(LABVAL(I))
  37. 23012 CONTINUE
  38. 23010 CONTINUE
  39.       XFER = 1
  40.       RETURN
  41. 23007 CONTINUE
  42. 23005 I = I - 1
  43.       GOTO 23004
  44. 23006 CONTINUE
  45.       IF(.NOT.(TOKEN .EQ. 10264))GOTO 23013
  46.       CALL SYNERR(14HILLEGAL BREAK.)
  47.       GOTO 23014
  48. 23013 CONTINUE
  49.       CALL SYNERR(13HILLEGAL NEXT.)
  50. 23014 CONTINUE
  51.       RETURN
  52.       END
  53.       SUBROUTINE GETDEF(TOKEN, TOKSIZ, DEFN, DEFSIZ, FD)
  54.       INTEGER GTOK, NGETCH
  55.       INTEGER DEFSIZ, FD, I, NLPAR, TOKSIZ
  56.       INTEGER C, DEFN(2500), TOKEN(100), T, PTOKEN(100)
  57.       CALL SKPBLK(FD)
  58.       C = GTOK(PTOKEN, 100, FD)
  59.       IF(.NOT.(C .EQ. 40))GOTO 23015
  60.       T = 40
  61.       GOTO 23016
  62. 23015 CONTINUE
  63.       T = 32
  64.       CALL PBSTR(PTOKEN)
  65. 23016 CONTINUE
  66.       CALL SKPBLK(FD)
  67.       IF(.NOT.(GTOK(TOKEN, TOKSIZ, FD) .NE. 10100))GOTO 23017
  68.       CALL BADERR(22HNON-ALPHANUMERIC NAME.)
  69. 23017 CONTINUE
  70.       CALL SKPBLK(FD)
  71.       C = GTOK(PTOKEN, 100, FD)
  72.       IF(.NOT.(T .EQ. 32))GOTO 23019
  73.       CALL PBSTR(PTOKEN)
  74.       I = 1
  75. 23021 CONTINUE
  76.       C = NGETCH(C, FD)
  77.       IF(.NOT.(I .GT. DEFSIZ))GOTO 23024
  78.       CALL BADERR(20HDEFINITION TOO LONG.)
  79. 23024 CONTINUE
  80.       DEFN(I) = C
  81.       I = I + 1
  82. 23022 IF(.NOT.(C .EQ. 35 .OR. C .EQ. 10 .OR. C .EQ. 10003))GOTO 23021
  83. 23023 CONTINUE
  84.       IF(.NOT.(C .EQ. 35))GOTO 23026
  85.       CALL PUTBAK(C)
  86. 23026 CONTINUE
  87.       GOTO 23020
  88. 23019 CONTINUE
  89.       IF(.NOT.(T .EQ. 40))GOTO 23028
  90.       IF(.NOT.(C .NE. 44))GOTO 23030
  91.       CALL BADERR(24HMISSING COMMA IN DEFINE.)
  92. 23030 CONTINUE
  93.       NLPAR = 0
  94.       I = 1
  95. 23032 IF(.NOT.(NLPAR .GE. 0))GOTO 23034
  96.       IF(.NOT.(I .GT. DEFSIZ))GOTO 23035
  97.       CALL BADERR(20HDEFINITION TOO LONG.)
  98.       GOTO 23036
  99. 23035 CONTINUE
  100.       IF(.NOT.(NGETCH(DEFN(I), FD) .EQ. 10003))GOTO 23037
  101.       CALL BADERR(20HMISSING RIGHT PAREN.)
  102.       GOTO 23038
  103. 23037 CONTINUE
  104.       IF(.NOT.(DEFN(I) .EQ. 40))GOTO 23039
  105.       NLPAR = NLPAR + 1
  106.       GOTO 23040
  107. 23039 CONTINUE
  108.       IF(.NOT.(DEFN(I) .EQ. 41))GOTO 23041
  109.       NLPAR = NLPAR - 1
  110. 23041 CONTINUE
  111. 23040 CONTINUE
  112. 23038 CONTINUE
  113. 23036 CONTINUE
  114. 23033 I = I + 1
  115.       GOTO 23032
  116. 23034 CONTINUE
  117.       GOTO 23029
  118. 23028 CONTINUE
  119.       CALL BADERR(19HGETDEF IS CONFUSED.)
  120. 23029 CONTINUE
  121. 23020 CONTINUE
  122.       DEFN(I-1) = 10002
  123.       RETURN
  124.       END
  125.       SUBROUTINE DOCODE(LAB)
  126.       INTEGER LABGEN
  127.       INTEGER LAB
  128.       INTEGER GNBTOK
  129.       INTEGER LEXSTR(100)
  130.       COMMON /CGOTO/ XFER
  131.       INTEGER XFER
  132.       INTEGER SDO(3)
  133.       DATA SDO(1)/100/,SDO(2)/111/,SDO(3)/10002/
  134.       XFER = 0
  135.       CALL OUTTAB
  136.       CALL OUTSTR(SDO)
  137.       CALL OUTCH(32)
  138.       LAB = LABGEN(2)
  139.       IF(.NOT.(GNBTOK(LEXSTR, 100) .EQ. 2))GOTO 23043
  140.       CALL OUTSTR(LEXSTR)
  141.       GOTO 23044
  142. 23043 CONTINUE
  143.       CALL PBSTR(LEXSTR)
  144.       CALL OUTNUM(LAB)
  145. 23044 CONTINUE
  146.       CALL OUTCH(32)
  147.       CALL EATUP
  148.       CALL OUTDON
  149.       RETURN
  150.       END
  151.       SUBROUTINE DOSTAT(LAB)
  152.       INTEGER LAB
  153.       CALL OUTCON(LAB)
  154.       CALL OUTCON(LAB+1)
  155.       RETURN
  156.       END
  157.       SUBROUTINE BADERR(MSG)
  158.       INTEGER MSG(100)
  159.       CALL SYNERR(MSG)
  160.       CALL ENDST
  161.       END
  162.       SUBROUTINE SYNERR(MSG)
  163.       INTEGER LC(20), MSG(100)
  164.       INTEGER ITOC
  165.       INTEGER I, JUNK
  166.       COMMON /CLINE/ RATLST, LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES(
  167.      * 90)
  168.       INTEGER RATLST
  169.       INTEGER LEVEL
  170.       INTEGER LINECT
  171.       INTEGER INFILE
  172.       INTEGER FNAMP
  173.       INTEGER FNAMES
  174.       INTEGER IN(5)
  175.       INTEGER ERRMSG(15)
  176.       DATA IN(1)/32/,IN(2)/105/,IN(3)/110/,IN(4)/32/,IN(5)/10002/
  177.       DATA ERRMSG(1)/101/,ERRMSG(2)/114/,ERRMSG(3)/114/,ERRMSG(4)/111/,E
  178.      *RRMSG(5)/114/,ERRMSG(6)/32/,ERRMSG(7)/97/,ERRMSG(8)/116/,ERRMSG(9)
  179.      */32/,ERRMSG(10)/108/,ERRMSG(11)/105/,ERRMSG(12)/110/,ERRMSG(13)/10
  180.      *1/,ERRMSG(14)/32/,ERRMSG(15)/10002/
  181.       CALL PUTLIN(ERRMSG, 3)
  182.       IF(.NOT.(LEVEL .GE. 1))GOTO 23045
  183.       I = LEVEL
  184.       GOTO 23046
  185. 23045 CONTINUE
  186.       I = 1
  187. 23046 CONTINUE
  188.       JUNK = ITOC (LINECT(I), LC, 20)
  189.       CALL PUTLIN(LC, 3)
  190.       I = FNAMP-1
  191. 23047 IF(.NOT.(I.GT.1))GOTO 23049
  192.       IF(.NOT.(FNAMES(I-1) .EQ. 10002))GOTO 23050
  193.       CALL PUTLIN(IN, 3)
  194.       CALL PUTLIN(FNAMES(I), 3)
  195.       GOTO 23049
  196. 23050 CONTINUE
  197. 23048 I=I-1
  198.       GOTO 23047
  199. 23049 CONTINUE
  200.       CALL PUTCH(58, 3)
  201.       CALL PUTCH(32, 3)
  202.       CALL REMARK (MSG)
  203.       RETURN
  204.       END
  205.       SUBROUTINE FORCOD(LAB)
  206.       INTEGER GETTOK, GNBTOK
  207.       INTEGER T, TOKEN(100)
  208.       INTEGER LENGTH, LABGEN
  209.       INTEGER I, J, LAB, NLPAR
  210.       COMMON /CFOR/ FORDEP, FORSTK(200)
  211.       INTEGER FORDEP
  212.       INTEGER FORSTK
  213.       INTEGER IFNOT(9)
  214.       DATA IFNOT(1)/105/,IFNOT(2)/102/,IFNOT(3)/40/,IFNOT(4)/46/,IFNOT(5
  215.      *)/110/,IFNOT(6)/111/,IFNOT(7)/116/,IFNOT(8)/46/,IFNOT(9)/10002/
  216.       LAB = LABGEN(3)
  217.       CALL OUTCON(0)
  218.       IF(.NOT.(GNBTOK(TOKEN, 100) .NE. 40))GOTO 23052
  219.       CALL SYNERR(19HMISSING LEFT PAREN.)
  220.       RETURN
  221. 23052 CONTINUE
  222.       IF(.NOT.(GNBTOK(TOKEN, 100) .NE. 59))GOTO 23054
  223.       CALL PBSTR(TOKEN)
  224.       CALL OUTTAB
  225.       CALL EATUP
  226.       CALL OUTDON
  227. 23054 CONTINUE
  228.       IF(.NOT.(GNBTOK(TOKEN, 100) .EQ. 59))GOTO 23056
  229.       CALL OUTCON(LAB)
  230.       GOTO 23057
  231. 23056 CONTINUE
  232.       CALL PBSTR(TOKEN)
  233.       CALL OUTNUM(LAB)
  234.       CALL OUTTAB
  235.       CALL OUTSTR(IFNOT)
  236.       CALL OUTCH(40)
  237.       NLPAR = 0
  238. 23058 IF(.NOT.(NLPAR .GE. 0))GOTO 23059
  239.       T = GETTOK(TOKEN, 100)
  240.       IF(.NOT.(T .EQ. 59))GOTO 23060
  241.       GOTO 23059
  242. 23060 CONTINUE
  243.       IF(.NOT.(T .EQ. 40))GOTO 23062
  244.       NLPAR = NLPAR + 1
  245.       GOTO 23063
  246. 23062 CONTINUE
  247.       IF(.NOT.(T .EQ. 41))GOTO 23064
  248.       NLPAR = NLPAR - 1
  249. 23064 CONTINUE
  250. 23063 CONTINUE
  251.       IF(.NOT.(T .EQ. 10003))GOTO 23066
  252.       CALL PBSTR(TOKEN)
  253.       RETURN
  254. 23066 CONTINUE
  255.       IF(.NOT.(T .NE. 10 .AND. T .NE. 95))GOTO 23068
  256.       CALL OUTSTR(TOKEN)
  257. 23068 CONTINUE
  258.       GOTO 23058
  259. 23059 CONTINUE
  260.       CALL OUTCH(41)
  261.       CALL OUTCH(41)
  262.       CALL OUTGO(LAB+2)
  263.       IF(.NOT.(NLPAR .LT. 0))GOTO 23070
  264.       CALL SYNERR(19HINVALID FOR CLAUSE.)
  265. 23070 CONTINUE
  266. 23057 CONTINUE
  267.       FORDEP = FORDEP + 1
  268.       J = 1
  269.       I = 1
  270. 23072 IF(.NOT.(I .LT. FORDEP))GOTO 23074
  271.       J = J + LENGTH(FORSTK(J)) + 1
  272. 23073 I = I + 1
  273.       GOTO 23072
  274. 23074 CONTINUE
  275.       FORSTK(J) = 10002
  276.       NLPAR = 0
  277.       T = GNBTOK(TOKEN, 100)
  278.       CALL PBSTR(TOKEN)
  279. 23075 IF(.NOT.(NLPAR .GE. 0))GOTO 23076
  280.       T = GETTOK(TOKEN, 100)
  281.       IF(.NOT.(T .EQ. 40))GOTO 23077
  282.       NLPAR = NLPAR + 1
  283.       GOTO 23078
  284. 23077 CONTINUE
  285.       IF(.NOT.(T .EQ. 41))GOTO 23079
  286.       NLPAR = NLPAR - 1
  287. 23079 CONTINUE
  288. 23078 CONTINUE
  289.       IF(.NOT.(T .EQ. 10003))GOTO 23081
  290.       CALL PBSTR(TOKEN)
  291.       GOTO 23076
  292. 23081 CONTINUE
  293.       IF(.NOT.(NLPAR .GE. 0 .AND. T .NE. 10 .AND. T .NE. 95))GOTO 23083
  294.       IF(.NOT.(J + LENGTH(TOKEN) .GE. 200))GOTO 23085
  295.       CALL BADERR(20HFOR CLAUSE TOO LONG.)
  296. 23085 CONTINUE
  297.       CALL SCOPY(TOKEN, 1, FORSTK, J)
  298.       J = J + LENGTH(TOKEN)
  299. 23083 CONTINUE
  300.       GOTO 23075
  301. 23076 CONTINUE
  302.       LAB = LAB + 1
  303.       RETURN
  304.       END
  305.       SUBROUTINE FORS(LAB)
  306.       INTEGER LENGTH
  307.       INTEGER I, J, LAB
  308.       COMMON /CFOR/ FORDEP, FORSTK(200)
  309.       INTEGER FORDEP
  310.       INTEGER FORSTK
  311.       COMMON /CGOTO/ XFER
  312.       INTEGER XFER
  313.       XFER = 0
  314.       CALL OUTNUM(LAB)
  315.       J = 1
  316.       I = 1
  317. 23087 IF(.NOT.(I .LT. FORDEP))GOTO 23089
  318.       J = J + LENGTH(FORSTK(J)) + 1
  319. 23088 I = I + 1
  320.       GOTO 23087
  321. 23089 CONTINUE
  322.       IF(.NOT.(LENGTH(FORSTK(J)) .GT. 0))GOTO 23090
  323.       CALL OUTTAB
  324.       CALL OUTSTR(FORSTK(J))
  325.       CALL OUTDON
  326. 23090 CONTINUE
  327.       CALL OUTGO(LAB-1)
  328.       CALL OUTCON(LAB+1)
  329.       FORDEP = FORDEP - 1
  330.       RETURN
  331.       END
  332.       SUBROUTINE BALPAR
  333.       INTEGER GETTOK, GNBTOK
  334.       INTEGER T, TOKEN(100)
  335.       INTEGER NLPAR
  336.       IF(.NOT.(GNBTOK(TOKEN, 100) .NE. 40))GOTO 23092
  337.       CALL SYNERR(19HMISSING LEFT PAREN.)
  338.       RETURN
  339. 23092 CONTINUE
  340.       CALL OUTSTR(TOKEN)
  341.       NLPAR = 1
  342. 23094 CONTINUE
  343.       T = GETTOK(TOKEN, 100)
  344.       IF(.NOT.(T.EQ.59 .OR. T.EQ.123 .OR. T.EQ.125 .OR. T.EQ.10003))GOTO
  345.      * 23097
  346.       CALL PBSTR(TOKEN)
  347.       GOTO 23096
  348. 23097 CONTINUE
  349.       IF(.NOT.(T .EQ. 10))GOTO 23099
  350.       TOKEN(1) = 10002
  351.       GOTO 23100
  352. 23099 CONTINUE
  353.       IF(.NOT.(T .EQ. 40))GOTO 23101
  354.       NLPAR = NLPAR + 1
  355.       GOTO 23102
  356. 23101 CONTINUE
  357.       IF(.NOT.(T .EQ. 41))GOTO 23103
  358.       NLPAR = NLPAR - 1
  359. 23103 CONTINUE
  360. 23102 CONTINUE
  361. 23100 CONTINUE
  362.       CALL OUTSTR(TOKEN)
  363. 23095 IF(.NOT.(NLPAR .LE. 0))GOTO 23094
  364. 23096 CONTINUE
  365.       IF(.NOT.(NLPAR .NE. 0))GOTO 23105
  366.       CALL SYNERR(33HMISSING PARENTHESIS IN CONDITION.)
  367. 23105 CONTINUE
  368.       RETURN
  369.       END
  370.       SUBROUTINE ELSEIF(LAB)
  371.       INTEGER LAB
  372.       CALL OUTGO(LAB+1)
  373.       CALL OUTCON(LAB)
  374.       RETURN
  375.       END
  376.       SUBROUTINE IFCODE(LAB)
  377.       INTEGER LABGEN
  378.       INTEGER LAB
  379.       COMMON /CGOTO/ XFER
  380.       INTEGER XFER
  381.       XFER = 0
  382.       LAB = LABGEN(2)
  383.       CALL IFGO(LAB)
  384.       RETURN
  385.       END
  386.       SUBROUTINE IFGO(LAB)
  387.       INTEGER LAB
  388.       INTEGER IFNOT(9)
  389.       DATA IFNOT(1)/105/,IFNOT(2)/102/,IFNOT(3)/40/,IFNOT(4)/46/,IFNOT(5
  390.      *)/110/,IFNOT(6)/111/,IFNOT(7)/116/,IFNOT(8)/46/,IFNOT(9)/10002/
  391.       CALL OUTTAB
  392.       CALL OUTSTR(IFNOT)
  393.       CALL BALPAR
  394.       CALL OUTCH(41)
  395.       CALL OUTGO(LAB)
  396.       RETURN
  397.       END
  398.       INTEGER FUNCTION GETTOK(TOKEN, TOKSIZ)
  399.       INTEGER EQUAL, OPEN, LENGTH
  400.       INTEGER I, TOKSIZ, F, LEN
  401.       INTEGER T
  402.       INTEGER DEFTOK, NGETCH
  403.       INTEGER GETCH
  404.       INTEGER NAME(30), TOKEN(100)
  405.       COMMON /CLINE/ RATLST, LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES(
  406.      * 90)
  407.       INTEGER RATLST
  408.       INTEGER LEVEL
  409.       INTEGER LINECT
  410.       INTEGER INFILE
  411.       INTEGER FNAMP
  412.       INTEGER FNAMES
  413.       COMMON /CFNAME/ FCNAME(30)
  414.       INTEGER FCNAME
  415.       INTEGER FNCN(9)
  416.       INTEGER INCL(8)
  417.       DATA FNCN(1)/102/,FNCN(2)/117/,FNCN(3)/110/,FNCN(4)/99/,FNCN(5)/11
  418.      *6/,FNCN(6)/105/,FNCN(7)/111/,FNCN(8)/110/,FNCN(9)/10002/
  419.       DATA INCL(1)/105/,INCL(2)/110/,INCL(3)/99/,INCL(4)/108/,INCL(5)/11
  420.      *7/,INCL(6)/100/,INCL(7)/101/,INCL(8)/10002/
  421. 23107 IF(.NOT.(LEVEL .GT. 0))GOTO 23109
  422.       F = INFILE(LEVEL)
  423.       GETTOK = DEFTOK(TOKEN, TOKSIZ, F)
  424. 23110 IF(.NOT.(GETTOK .NE. 10003))GOTO 23112
  425.       IF(.NOT.(EQUAL(TOKEN, FNCN) .EQ. 1))GOTO 23113
  426.       CALL SKPBLK(INFILE(LEVEL))
  427.       T = DEFTOK(FCNAME, 30, F)
  428.       CALL PBSTR(FCNAME)
  429.       IF(.NOT.(T .NE. 10100))GOTO 23115
  430.       CALL SYNERR(22HMISSING FUNCTION NAME.)
  431. 23115 CONTINUE
  432.       CALL PUTBAK(32)
  433.       RETURN
  434. 23113 CONTINUE
  435.       IF(.NOT.(EQUAL(TOKEN, INCL) .EQ. 0))GOTO 23117
  436.       RETURN
  437. 23117 CONTINUE
  438. 23114 CONTINUE
  439.       CALL SKPBLK(INFILE(LEVEL))
  440.       T = DEFTOK(NAME, 30, INFILE(LEVEL))
  441.       IF(.NOT.(T .EQ. 39 .OR. T .EQ. 34))GOTO 23119
  442.       LEN = LENGTH(NAME) - 1
  443.       I=1
  444. 23121 IF(.NOT.(I .LT. LEN))GOTO 23123
  445.       NAME(I) = NAME(I+1)
  446. 23122 I=I+1
  447.       GOTO 23121
  448. 23123 CONTINUE
  449.       NAME(I) = 10002
  450. 23119 CONTINUE
  451.       I = LENGTH(NAME) + 1
  452.       IF(.NOT.(LEVEL .GE. 3))GOTO 23124
  453.       CALL SYNERR(27HINCLUDES NESTED TOO DEEPLY.)
  454.       GOTO 23125
  455. 23124 CONTINUE
  456.       INFILE(LEVEL+1) = OPEN(NAME, 1)
  457.       LINECT(LEVEL+1) = 1
  458.       IF(.NOT.(INFILE(LEVEL+1) .EQ. 10001))GOTO 23126
  459.       CALL SYNERR(19HCAN'T OPEN INCLUDE.)
  460.       GOTO 23127
  461. 23126 CONTINUE
  462.       LEVEL = LEVEL + 1
  463.       IF(.NOT.(FNAMP + I .LE.  90))GOTO 23128
  464.       CALL SCOPY(NAME, 1, FNAMES, FNAMP)
  465.       FNAMP = FNAMP + I
  466. 23128 CONTINUE
  467.       F = INFILE(LEVEL)
  468. 23127 CONTINUE
  469. 23125 CONTINUE
  470. 23111  GETTOK = DEFTOK(TOKEN, TOKSIZ, F)
  471.       GOTO 23110
  472. 23112 CONTINUE
  473.       IF(.NOT.(LEVEL .GT. 1))GOTO 23130
  474.       CALL CLOSE(INFILE(LEVEL))
  475.       FNAMP = FNAMP - 1
  476. 23132 IF(.NOT.(FNAMP .GT. 1))GOTO 23134
  477.       IF(.NOT.(FNAMES(FNAMP-1) .EQ. 10002))GOTO 23135
  478.       GOTO 23134
  479. 23135 CONTINUE
  480. 23133 FNAMP = FNAMP - 1
  481.       GOTO 23132
  482. 23134 CONTINUE
  483. 23130 CONTINUE
  484. 23108 LEVEL = LEVEL - 1
  485.       GOTO 23107
  486. 23109 CONTINUE
  487.       TOKEN(1) = 10003
  488.       TOKEN(2) = 10002
  489.       GETTOK = 10003
  490.       RETURN
  491.       END
  492.       INTEGER FUNCTION GNBTOK(TOKEN, TOKSIZ)
  493.       INTEGER TOKSIZ
  494.       INTEGER TOKEN(100), GETTOK
  495.       COMMON /CLINE/ RATLST, LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES(
  496.      * 90)
  497.       INTEGER RATLST
  498.       INTEGER LEVEL
  499.       INTEGER LINECT
  500.       INTEGER INFILE
  501.       INTEGER FNAMP
  502.       INTEGER FNAMES
  503.       CALL SKPBLK(INFILE(LEVEL))
  504.       GNBTOK = GETTOK(TOKEN, TOKSIZ)
  505.       RETURN
  506.       END
  507.       INTEGER FUNCTION GTOK(LEXSTR, TOKSIZ, FD)
  508.       INTEGER NGETCH, TYPE
  509.       INTEGER FD, I, B, N, TOKSIZ, ITOC
  510.       INTEGER C, LEXSTR(100)
  511.       COMMON /CLINE/ RATLST, LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES(
  512.      * 90)
  513.       INTEGER RATLST
  514.       INTEGER LEVEL
  515.       INTEGER LINECT
  516.       INTEGER INFILE
  517.       INTEGER FNAMP
  518.       INTEGER FNAMES
  519.       C = NGETCH(LEXSTR(1), FD)
  520.       IF(.NOT.(C .EQ. 32 .OR. C .EQ. 9))GOTO 23137
  521.       LEXSTR(1) = 32
  522. 23139 IF(.NOT.(C .EQ. 32 .OR. C .EQ. 9))GOTO 23140
  523.       C = NGETCH(C, FD)
  524.       GOTO 23139
  525. 23140 CONTINUE
  526.       IF(.NOT.(C .EQ. 35))GOTO 23141
  527. 23143 IF(.NOT.(NGETCH(C, FD) .NE. 10))GOTO 23144
  528.       GOTO 23143
  529. 23144 CONTINUE
  530. 23141 CONTINUE
  531.       IF(.NOT.(C .NE. 10))GOTO 23145
  532.       CALL PUTBAK(C)
  533.       GOTO 23146
  534. 23145 CONTINUE
  535.       LEXSTR(1) = 10
  536. 23146 CONTINUE
  537.       LEXSTR(2) = 10002
  538.       GTOK = LEXSTR(1)
  539.       RETURN
  540. 23137 CONTINUE
  541.       I = 1
  542.       GTOK = TYPE(C)
  543.       IF(.NOT.(GTOK .EQ. 1))GOTO 23147
  544.       I = 1
  545. 23149 IF(.NOT.(I .LT. TOKSIZ - 2))GOTO 23151
  546.       GTOK = TYPE(NGETCH(LEXSTR(I+1), FD))
  547.       IF(.NOT.(GTOK .NE. 1 .AND. GTOK .NE. 2 .AND. GTOK .NE. 95 .AND. GT
  548.      *OK .NE. 46))GOTO 23152
  549.       GOTO 23151
  550. 23152 CONTINUE
  551. 23150 I = I + 1
  552.       GOTO 23149
  553. 23151 CONTINUE
  554.       CALL PUTBAK(LEXSTR(I+1))
  555.       GTOK = 10100
  556.       GOTO 23148
  557. 23147 CONTINUE
  558.       IF(.NOT.(GTOK .EQ. 2))GOTO 23154
  559.       B = C - 48
  560.       I = 1
  561. 23156 IF(.NOT.(I .LT. TOKSIZ - 2))GOTO 23158
  562.       IF(.NOT.(TYPE(NGETCH(LEXSTR(I+1), FD)) .NE. 2))GOTO 23159
  563.       GOTO 23158
  564. 23159 CONTINUE
  565.       B = 10*B + LEXSTR(I+1) - 48
  566. 23157 I = I + 1
  567.       GOTO 23156
  568. 23158 CONTINUE
  569.       IF(.NOT.(LEXSTR(I+1) .EQ. 37 .AND. B .GE. 2 .AND. B .LE. 36))GOTO
  570.      *23161
  571.       N = 0
  572. 23163 CONTINUE
  573.       C = NGETCH(LEXSTR(1), FD)
  574.       IF(.NOT.(C .GE. 97 .AND. C .LE. 122))GOTO 23166
  575.       C = C - 97 + 57 + 1
  576.       GOTO 23167
  577. 23166 CONTINUE
  578.       IF(.NOT.(C .GE. 65 .AND. C .LE. 90))GOTO 23168
  579.       C = C - 65 + 57 + 1
  580. 23168 CONTINUE
  581. 23167 CONTINUE
  582.       IF(.NOT.(C .LT. 48 .OR. C .GE. 48 + B))GOTO 23170
  583.       GOTO 23165
  584. 23170 CONTINUE
  585. 23164 N = B*N + C - 48
  586.       GOTO 23163
  587. 23165 CONTINUE
  588.       CALL PUTBAK(LEXSTR(1))
  589.       I = ITOC(N, LEXSTR, TOKSIZ)
  590.       GOTO 23162
  591. 23161 CONTINUE
  592.       CALL PUTBAK(LEXSTR(I+1))
  593. 23162 CONTINUE
  594.       GTOK = 2
  595.       GOTO 23155
  596. 23154 CONTINUE
  597.       IF(.NOT.(C .EQ. 91))GOTO 23172
  598.       LEXSTR(1) = 123
  599.       GTOK = 123
  600.       GOTO 23173
  601. 23172 CONTINUE
  602.       IF(.NOT.(C .EQ. 93))GOTO 23174
  603.       LEXSTR(1) = 125
  604.       GTOK = 125
  605.       GOTO 23175
  606. 23174 CONTINUE
  607.       IF(.NOT.(C .EQ. 36))GOTO 23176
  608.       IF(.NOT.(NGETCH(LEXSTR(2), FD) .EQ. 40))GOTO 23178
  609.       I = 2
  610.       GTOK = 10279
  611.       GOTO 23179
  612. 23178 CONTINUE
  613.       IF(.NOT.(LEXSTR(2) .EQ. 41))GOTO 23180
  614.       I = 2
  615.       GTOK = 10280
  616.       GOTO 23181
  617. 23180 CONTINUE
  618.       CALL PUTBAK(LEXSTR(2))
  619. 23181 CONTINUE
  620. 23179 CONTINUE
  621.       GOTO 23177
  622. 23176 CONTINUE
  623.       IF(.NOT.(C .EQ. 39 .OR. C .EQ. 34))GOTO 23182
  624.       I = 2
  625. 23184 IF(.NOT.(NGETCH(LEXSTR(I), FD) .NE. LEXSTR(1)))GOTO 23186
  626.       IF(.NOT.(LEXSTR(I) .EQ. 95))GOTO 23187
  627.       IF(.NOT.(NGETCH(C, FD) .EQ. 10))GOTO 23189
  628. 23191 IF(.NOT.(C .EQ. 10 .OR. C .EQ. 32 .OR. C .EQ. 9))GOTO 23192
  629.       C = NGETCH(C, FD)
  630.       GOTO 23191
  631. 23192 CONTINUE
  632.       LEXSTR(I) = C
  633.       GOTO 23190
  634. 23189 CONTINUE
  635.       CALL PUTBAK(C)
  636. 23190 CONTINUE
  637. 23187 CONTINUE
  638.       IF(.NOT.(LEXSTR(I) .EQ. 10 .OR. I .GE. TOKSIZ-1))GOTO 23193
  639.       CALL SYNERR(14HMISSING QUOTE.)
  640.       LEXSTR(I) = LEXSTR(1)
  641.       CALL PUTBAK(10)
  642.       GOTO 23186
  643. 23193 CONTINUE
  644. 23185 I = I + 1
  645.       GOTO 23184
  646. 23186 CONTINUE
  647.       GOTO 23183
  648. 23182 CONTINUE
  649.       IF(.NOT.(C .EQ. 35))GOTO 23195
  650. 23197 IF(.NOT.(NGETCH(LEXSTR(1), FD) .NE. 10))GOTO 23198
  651.       GOTO 23197
  652. 23198 CONTINUE
  653.       GTOK = 10
  654.       GOTO 23196
  655. 23195 CONTINUE
  656.       IF(.NOT.(C .EQ. 62 .OR. C .EQ. 60 .OR. C .EQ. 33 .OR. C .EQ. 33 .O
  657.      *R. C .EQ. 126 .OR. C .EQ. 94 .OR. C .EQ. 61 .OR. C .EQ. 38 .OR. C
  658.      *.EQ. 124))GOTO 23199
  659.       CALL RELATE(LEXSTR, I, FD)
  660. 23199 CONTINUE
  661. 23196 CONTINUE
  662. 23183 CONTINUE
  663. 23177 CONTINUE
  664. 23175 CONTINUE
  665. 23173 CONTINUE
  666. 23155 CONTINUE
  667. 23148 CONTINUE
  668.       IF(.NOT.(I .GE. TOKSIZ-1))GOTO 23201
  669.       CALL SYNERR(15HTOKEN TOO LONG.)
  670. 23201 CONTINUE
  671.       LEXSTR(I+1) = 10002
  672.       RETURN
  673.       END
  674.       INTEGER FUNCTION LEX(LEXSTR)
  675.       INTEGER GNBTOK, DEFTOK
  676.       INTEGER LEXSTR(100)
  677.       INTEGER EQUAL
  678.       INTEGER SIF(3)
  679.       INTEGER SELSE(5)
  680.       INTEGER SWHILE(6)
  681.       INTEGER SDO(3)
  682.       INTEGER SBREAK(6)
  683.       INTEGER SNEXT(5)
  684.       INTEGER SFOR(4)
  685.       INTEGER SREPT(7)
  686.       INTEGER SUNTIL(6)
  687.       INTEGER SRET(7)
  688.       INTEGER SSTR(7)
  689.       INTEGER SSWTCH(7)
  690.       INTEGER SCASE(5)
  691.       INTEGER SDEFLT(8)
  692.       DATA SIF(1)/105/,SIF(2)/102/,SIF(3)/10002/
  693.       DATA SELSE(1)/101/,SELSE(2)/108/,SELSE(3)/115/,SELSE(4)/101/,SELSE
  694.      *(5)/10002/
  695.       DATA SWHILE(1)/119/,SWHILE(2)/104/,SWHILE(3)/105/,SWHILE(4)/108/,S
  696.      *WHILE(5)/101/,SWHILE(6)/10002/
  697.       DATA SDO(1)/100/,SDO(2)/111/,SDO(3)/10002/
  698.       DATA SBREAK(1)/98/,SBREAK(2)/114/,SBREAK(3)/101/,SBREAK(4)/97/,SBR
  699.      *EAK(5)/107/,SBREAK(6)/10002/
  700.       DATA SNEXT(1)/110/,SNEXT(2)/101/,SNEXT(3)/120/,SNEXT(4)/116/,SNEXT
  701.      *(5)/10002/
  702.       DATA SFOR(1)/102/,SFOR(2)/111/,SFOR(3)/114/,SFOR(4)/10002/
  703.       DATA SREPT(1)/114/,SREPT(2)/101/,SREPT(3)/112/,SREPT(4)/101/,SREPT
  704.      *(5)/97/,SREPT(6)/116/,SREPT(7)/10002/
  705.       DATA SUNTIL(1)/117/,SUNTIL(2)/110/,SUNTIL(3)/116/,SUNTIL(4)/105/,S
  706.      *UNTIL(5)/108/,SUNTIL(6)/10002/
  707.       DATA SRET(1)/114/,SRET(2)/101/,SRET(3)/116/,SRET(4)/117/,SRET(5)/1
  708.      *14/,SRET(6)/110/,SRET(7)/10002/
  709.       DATA SSTR(1)/115/,SSTR(2)/116/,SSTR(3)/114/,SSTR(4)/105/,SSTR(5)/1
  710.      *10/,SSTR(6)/103/,SSTR(7)/10002/
  711.       DATA SSWTCH(1)/115/,SSWTCH(2)/119/,SSWTCH(3)/105/,SSWTCH(4)/116/,S
  712.      *SWTCH(5)/99/,SSWTCH(6)/104/,SSWTCH(7)/10002/
  713.       DATA SCASE(1)/99/,SCASE(2)/97/,SCASE(3)/115/,SCASE(4)/101/,SCASE(5
  714.      *)/10002/
  715.       DATA SDEFLT(1)/100/,SDEFLT(2)/101/,SDEFLT(3)/102/,SDEFLT(4)/97/,SD
  716.      *EFLT(5)/117/,SDEFLT(6)/108/,SDEFLT(7)/116/,SDEFLT(8)/10002/
  717.       LEX = GNBTOK(LEXSTR, 100)
  718. 23203 IF(.NOT.(LEX .EQ. 10))GOTO 23205
  719. 23204  LEX = GNBTOK(LEXSTR, 100)
  720.       GOTO 23203
  721. 23205 CONTINUE
  722.       IF(.NOT.(LEX .EQ. 10003 .OR. LEX .EQ. 59 .OR. LEX .EQ. 123 .OR. LE
  723.      *X .EQ. 125))GOTO 23206
  724.       RETURN
  725. 23206 CONTINUE
  726.       IF(.NOT.(LEX .EQ. 2))GOTO 23208
  727.       LEX = 10260
  728.       GOTO 23209
  729. 23208 CONTINUE
  730.       IF(.NOT.(LEX .EQ. 37))GOTO 23210
  731.       LEX = 10278
  732.       GOTO 23211
  733. 23210 CONTINUE
  734.       IF(.NOT.(EQUAL(LEXSTR, SIF) .EQ. 1))GOTO 23212
  735.       LEX = 10261
  736.       GOTO 23213
  737. 23212 CONTINUE
  738.       IF(.NOT.(EQUAL(LEXSTR, SELSE) .EQ. 1))GOTO 23214
  739.       LEX = 10262
  740.       GOTO 23215
  741. 23214 CONTINUE
  742.       IF(.NOT.(EQUAL(LEXSTR, SWHILE) .EQ. 1))GOTO 23216
  743.       LEX = 10263
  744.       GOTO 23217
  745. 23216 CONTINUE
  746.       IF(.NOT.(EQUAL(LEXSTR, SDO) .EQ. 1))GOTO 23218
  747.       LEX = 10266
  748.       GOTO 23219
  749. 23218 CONTINUE
  750.       IF(.NOT.(EQUAL(LEXSTR, SBREAK) .EQ. 1))GOTO 23220
  751.       LEX = 10264
  752.       GOTO 23221
  753. 23220 CONTINUE
  754.       IF(.NOT.(EQUAL(LEXSTR, SNEXT) .EQ. 1))GOTO 23222
  755.       LEX = 10265
  756.       GOTO 23223
  757. 23222 CONTINUE
  758.       IF(.NOT.(EQUAL(LEXSTR, SFOR) .EQ. 1))GOTO 23224
  759.       LEX = 10268
  760.       GOTO 23225
  761. 23224 CONTINUE
  762.       IF(.NOT.(EQUAL(LEXSTR, SREPT) .EQ. 1))GOTO 23226
  763.       LEX = 10269
  764.       GOTO 23227
  765. 23226 CONTINUE
  766.       IF(.NOT.(EQUAL(LEXSTR, SUNTIL) .EQ. 1))GOTO 23228
  767.       LEX = 10270
  768.       GOTO 23229
  769. 23228 CONTINUE
  770.       IF(.NOT.(EQUAL(LEXSTR, SRET) .EQ. 1))GOTO 23230
  771.       LEX = 10271
  772.       GOTO 23231
  773. 23230 CONTINUE
  774.       IF(.NOT.(EQUAL(LEXSTR, SSTR) .EQ. 1))GOTO 23232
  775.       LEX = 10274
  776.       GOTO 23233
  777. 23232 CONTINUE
  778.       IF(.NOT.(EQUAL(LEXSTR, SSWTCH) .EQ. 1))GOTO 23234
  779.       LEX = 10275
  780.       GOTO 23235
  781. 23234 CONTINUE
  782.       IF(.NOT.(EQUAL(LEXSTR, SCASE) .EQ. 1))GOTO 23236
  783.       LEX = 10276
  784.       GOTO 23237
  785. 23236 CONTINUE
  786.       IF(.NOT.(EQUAL(LEXSTR, SDEFLT) .EQ. 1))GOTO 23238
  787.       LEX = 10277
  788.       GOTO 23239
  789. 23238 CONTINUE
  790.       LEX = 10267
  791. 23239 CONTINUE
  792. 23237 CONTINUE
  793. 23235 CONTINUE
  794. 23233 CONTINUE
  795. 23231 CONTINUE
  796. 23229 CONTINUE
  797. 23227 CONTINUE
  798. 23225 CONTINUE
  799. 23223 CONTINUE
  800. 23221 CONTINUE
  801. 23219 CONTINUE
  802. 23217 CONTINUE
  803. 23215 CONTINUE
  804. 23213 CONTINUE
  805. 23211 CONTINUE
  806. 23209 CONTINUE
  807.       RETURN
  808.       END
  809.       INTEGER FUNCTION NGETCH(C, FD)
  810.       INTEGER GETCH
  811.       INTEGER C
  812.       INTEGER FD
  813.       COMMON /CDEFIO/ BP, BUF(300)
  814.       INTEGER BP
  815.       INTEGER BUF
  816.       COMMON /CLINE/ RATLST, LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES(
  817.      * 90)
  818.       INTEGER RATLST
  819.       INTEGER LEVEL
  820.       INTEGER LINECT
  821.       INTEGER INFILE
  822.       INTEGER FNAMP
  823.       INTEGER FNAMES
  824.       IF(.NOT.(BP .GT. 0))GOTO 23240
  825.       C = BUF(BP)
  826.       BP = BP - 1
  827.       GOTO 23241
  828. 23240 CONTINUE
  829.       C = GETCH(C, FD)
  830.       IF(.NOT.(RATLST .EQ. 1))GOTO 23242
  831.       CALL PUTCH(C, 3)
  832. 23242 CONTINUE
  833. 23241 CONTINUE
  834.       NGETCH = C
  835.       IF(.NOT.(C .EQ. 10))GOTO 23244
  836.       LINECT(LEVEL) = LINECT(LEVEL) + 1
  837. 23244 CONTINUE
  838.       RETURN
  839.       END
  840.       SUBROUTINE PBSTR(IN)
  841.       INTEGER IN(100)
  842.       INTEGER LENGTH
  843.       INTEGER I
  844.       I = LENGTH(IN)
  845. 23246 IF(.NOT.(I .GT. 0))GOTO 23248
  846.       CALL PUTBAK(IN(I))
  847. 23247 I = I - 1
  848.       GOTO 23246
  849. 23248 CONTINUE
  850.       RETURN
  851.       END
  852.       SUBROUTINE PUTBAK(C)
  853.       INTEGER C
  854.       COMMON /CDEFIO/ BP, BUF(300)
  855.       INTEGER BP
  856.       INTEGER BUF
  857.       COMMON /CLINE/ RATLST, LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES(
  858.      * 90)
  859.       INTEGER RATLST
  860.       INTEGER LEVEL
  861.       INTEGER LINECT
  862.       INTEGER INFILE
  863.       INTEGER FNAMP
  864.       INTEGER FNAMES
  865.       BP = BP + 1
  866.       IF(.NOT.(BP .GT. 300))GOTO 23249
  867.       CALL BADERR(32HTOO MANY CHARACTERS PUSHED BACK.)
  868. 23249 CONTINUE
  869.       BUF(BP) = C
  870.       IF(.NOT.(C .EQ. 10))GOTO 23251
  871.       LINECT(LEVEL) = LINECT(LEVEL) - 1
  872. 23251 CONTINUE
  873.       RETURN
  874.       END
  875.       SUBROUTINE RELATE(TOKEN, LAST, FD)
  876.       INTEGER NGETCH
  877.       INTEGER TOKEN(100)
  878.       INTEGER LENGTH
  879.       INTEGER FD, LAST
  880.       IF(.NOT.(NGETCH(TOKEN(2), FD) .NE. 61))GOTO 23253
  881.       CALL PUTBAK(TOKEN(2))
  882.       TOKEN(3) = 116
  883.       GOTO 23254
  884. 23253 CONTINUE
  885.       TOKEN(3) = 101
  886. 23254 CONTINUE
  887.       TOKEN(4) = 46
  888.       TOKEN(5) = 10002
  889.       TOKEN(6) = 10002
  890.       IF(.NOT.(TOKEN(1) .EQ. 62))GOTO 23255
  891.       TOKEN(2) = 103
  892.       GOTO 23256
  893. 23255 CONTINUE
  894.       IF(.NOT.(TOKEN(1) .EQ. 60))GOTO 23257
  895.       TOKEN(2) = 108
  896.       GOTO 23258
  897. 23257 CONTINUE
  898.       IF(.NOT.(TOKEN(1) .EQ. 33 .OR. TOKEN(1) .EQ. 33 .OR. TOKEN(1) .EQ.
  899.      * 94 .OR. TOKEN(1) .EQ. 126))GOTO 23259
  900.       IF(.NOT.(TOKEN(2) .NE. 61))GOTO 23261
  901.       TOKEN(3) = 111
  902.       TOKEN(4) = 116
  903.       TOKEN(5) = 46
  904. 23261 CONTINUE
  905.       TOKEN(2) = 110
  906.       GOTO 23260
  907. 23259 CONTINUE
  908.       IF(.NOT.(TOKEN(1) .EQ. 61))GOTO 23263
  909.       IF(.NOT.(TOKEN(2) .NE. 61))GOTO 23265
  910.       TOKEN(2) = 10002
  911.       LAST = 1
  912.       RETURN
  913. 23265 CONTINUE
  914.       TOKEN(2) = 101
  915.       TOKEN(3) = 113
  916.       GOTO 23264
  917. 23263 CONTINUE
  918.       IF(.NOT.(TOKEN(1) .EQ. 38))GOTO 23267
  919.       TOKEN(2) = 97
  920.       TOKEN(3) = 110
  921.       TOKEN(4) = 100
  922.       TOKEN(5) = 46
  923.       GOTO 23268
  924. 23267 CONTINUE
  925.       IF(.NOT.(TOKEN(1) .EQ. 124))GOTO 23269
  926.       TOKEN(2) = 111
  927.       TOKEN(3) = 114
  928.       GOTO 23270
  929. 23269 CONTINUE
  930.       TOKEN(2) = 10002
  931. 23270 CONTINUE
  932. 23268 CONTINUE
  933. 23264 CONTINUE
  934. 23260 CONTINUE
  935. 23258 CONTINUE
  936. 23256 CONTINUE
  937.       TOKEN(1) = 46
  938.       LAST = LENGTH(TOKEN)
  939.       RETURN
  940.       END
  941.       SUBROUTINE LITRAL
  942.       INTEGER NGETCH
  943.       COMMON /COUTLN/ OUTP, OUTBUF(74)
  944.       INTEGER OUTP
  945.       INTEGER OUTBUF
  946.       COMMON /CLINE/ RATLST, LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES(
  947.      * 90)
  948.       INTEGER RATLST
  949.       INTEGER LEVEL
  950.       INTEGER LINECT
  951.       INTEGER INFILE
  952.       INTEGER FNAMP
  953.       INTEGER FNAMES
  954.       IF(.NOT.(OUTP .GT. 0))GOTO 23271
  955.       CALL OUTDON
  956. 23271 CONTINUE
  957.       OUTP = 1
  958. 23273 IF(.NOT.(NGETCH(OUTBUF(OUTP), INFILE(LEVEL)) .NE. 10))GOTO 23275
  959. 23274  OUTP = OUTP + 1
  960.       GOTO 23273
  961. 23275 CONTINUE
  962.       OUTP = OUTP - 1
  963.       CALL OUTDON
  964.       RETURN
  965.       END
  966.       INTEGER FUNCTION DEFTOK(TOKEN, TOKSIZ, FD)
  967.       INTEGER TOKEN(100)
  968.       INTEGER TOKSIZ, FD
  969.       INTEGER GTOK
  970.       INTEGER LOOKUP, PUSH, IFPARM
  971.       INTEGER T, C, DEFN(2500), BALP(3), MDEFN(2500)
  972.       INTEGER AP, ARGSTK(100), CALLST(50), NLB, PLEV(50), IFL
  973.       COMMON /CMACRO/ CP, EP, EVALST(500)
  974.       INTEGER CP
  975.       INTEGER EP
  976.       INTEGER EVALST
  977.       DATA BALP/40, 41, 10002/
  978.       CP = 0
  979.       AP = 1
  980.       EP = 1
  981.       T=GTOK(TOKEN,TOKSIZ,FD)
  982. 23276 IF(.NOT.(T .NE. 10003))GOTO 23278
  983.       IF(.NOT.(T .EQ. 10100))GOTO 23279
  984.       IF(.NOT.(LOOKUP(TOKEN, DEFN) .EQ. 0))GOTO 23281
  985.       IF(.NOT.(CP .EQ. 0))GOTO 23283
  986.       GOTO 23278
  987. 23283 CONTINUE
  988.       CALL PUTTOK(TOKEN)
  989. 23284 CONTINUE
  990.       GOTO 23282
  991. 23281 CONTINUE
  992.       IF(.NOT.(DEFN(1) .EQ. 10010))GOTO 23285
  993.       CALL GETDEF(TOKEN, TOKSIZ, DEFN, 2500, FD)
  994.       CALL INSTAL(TOKEN, DEFN)
  995.       GOTO 23286
  996. 23285 CONTINUE
  997.       IF(.NOT.(DEFN(1) .EQ. 215 .OR. DEFN(1) .EQ. 216))GOTO 23287
  998.       C = DEFN(1)
  999.       CALL GETDEF(TOKEN, TOKSIZ, DEFN, 2500, FD)
  1000.       IFL = LOOKUP(TOKEN, MDEFN)
  1001.       IF(.NOT.((IFL .EQ. 1 .AND. C .EQ. 215) .OR. (IFL .EQ. 0 .AND. C .E
  1002.      *Q. 216)))GOTO 23289
  1003.       CALL PBSTR(DEFN)
  1004. 23289 CONTINUE
  1005.       GOTO 23288
  1006. 23287 CONTINUE
  1007.       CP = CP + 1
  1008.       IF(.NOT.(CP .GT. 50))GOTO 23291
  1009.       CALL BADERR(20HCALL STACK OVERFLOW.)
  1010. 23291 CONTINUE
  1011.       CALLST(CP) = AP
  1012.       AP = PUSH(EP, ARGSTK, AP)
  1013.       CALL PUTTOK(DEFN)
  1014.       CALL PUTCHR(10002)
  1015.       AP = PUSH(EP, ARGSTK, AP)
  1016.       CALL PUTTOK(TOKEN)
  1017.       CALL PUTCHR(10002)
  1018.       AP = PUSH(EP, ARGSTK, AP)
  1019.       T = GTOK(TOKEN, TOKSIZ, FD)
  1020.       CALL PBSTR(TOKEN)
  1021.       IF(.NOT.(T .NE. 40))GOTO 23293
  1022.       CALL PBSTR(BALP)
  1023.       GOTO 23294
  1024. 23293 CONTINUE
  1025.       IF(.NOT.(IFPARM(DEFN) .EQ. 0))GOTO 23295
  1026.       CALL PBSTR(BALP)
  1027. 23295 CONTINUE
  1028. 23294 CONTINUE
  1029.       PLEV(CP) = 0
  1030. 23288 CONTINUE
  1031. 23286 CONTINUE
  1032. 23282 CONTINUE
  1033.       GOTO 23280
  1034. 23279 CONTINUE
  1035.       IF(.NOT.(T .EQ. 10279))GOTO 23297
  1036.       NLB = 1
  1037. 23299 CONTINUE
  1038.       T = GTOK(TOKEN, TOKSIZ, FD)
  1039.       IF(.NOT.(T .EQ. 10279))GOTO 23302
  1040.       NLB = NLB + 1
  1041.       GOTO 23303
  1042. 23302 CONTINUE
  1043.       IF(.NOT.(T .EQ. 10280))GOTO 23304
  1044.       NLB = NLB - 1
  1045.       IF(.NOT.(NLB .EQ. 0))GOTO 23306
  1046.       GOTO 23301
  1047. 23306 CONTINUE
  1048.       GOTO 23305
  1049. 23304 CONTINUE
  1050.       IF(.NOT.(T .EQ. 10003))GOTO 23308
  1051.       CALL BADERR(14HEOF IN STRING.)
  1052. 23308 CONTINUE
  1053. 23305 CONTINUE
  1054. 23303 CONTINUE
  1055.       CALL PUTTOK(TOKEN)
  1056. 23300 GOTO 23299
  1057. 23301 CONTINUE
  1058.       GOTO 23298
  1059. 23297 CONTINUE
  1060.       IF(.NOT.(CP .EQ. 0))GOTO 23310
  1061.       GOTO 23278
  1062. 23310 CONTINUE
  1063.       IF(.NOT.(T .EQ. 40))GOTO 23312
  1064.       IF(.NOT.(PLEV(CP) .GT. 0))GOTO 23314
  1065.       CALL PUTTOK(TOKEN)
  1066. 23314 CONTINUE
  1067.       PLEV(CP) = PLEV(CP) + 1
  1068.       GOTO 23313
  1069. 23312 CONTINUE
  1070.       IF(.NOT.(T .EQ. 41))GOTO 23316
  1071.       PLEV(CP) = PLEV(CP) - 1
  1072.       IF(.NOT.(PLEV(CP) .GT. 0))GOTO 23318
  1073.       CALL PUTTOK(TOKEN)
  1074.       GOTO 23319
  1075. 23318 CONTINUE
  1076.       CALL PUTCHR(10002)
  1077.       CALL EVALR(ARGSTK, CALLST(CP), AP-1)
  1078.       AP = CALLST(CP)
  1079.       EP = ARGSTK(AP)
  1080.       CP = CP - 1
  1081. 23319 CONTINUE
  1082.       GOTO 23317
  1083. 23316 CONTINUE
  1084.       IF(.NOT.(T .EQ. 44 .AND. PLEV(CP) .EQ. 1))GOTO 23320
  1085.       CALL PUTCHR(10002)
  1086.       AP = PUSH(EP, ARGSTK, AP)
  1087.       GOTO 23321
  1088. 23320 CONTINUE
  1089.       CALL PUTTOK(TOKEN)
  1090. 23321 CONTINUE
  1091. 23317 CONTINUE
  1092. 23313 CONTINUE
  1093. 23311 CONTINUE
  1094. 23298 CONTINUE
  1095. 23280 CONTINUE
  1096. 23277 T=GTOK(TOKEN,TOKSIZ,FD)
  1097.       GOTO 23276
  1098. 23278 CONTINUE
  1099.       DEFTOK = T
  1100.       IF(.NOT.(T .EQ. 10100))GOTO 23322
  1101.       CALL FOLD(TOKEN)
  1102. 23322 CONTINUE
  1103.   Ã¡   RETURN
  1104.       END
  1105.       SUBROUTINE DOARTH(ARGSTK,I,J)
  1106.       INTEGER CTOI
  1107.       INTEGER ARGSTK(100), I, J, K, L
  1108.       INTEGER OP
  1109.       COMMON /CMACRO/ CP, EP, EVALST(500)
  1110.       INTEGER CP
  1111.       INTEGER EP
  1112.       INTEGER EVALST
  1113.       K = ARGSTK(I+2)
  1114.       L = ARGSTK(I+4)
  1115.       OP = EVALST(ARGSTK(I+3))
  1116.       IF(.NOT.(OP .EQ. 43))GOTO 23324
  1117.       CALL PBNUM(CTOI(EVALST,K)+CTOI(EVALST,L))
  1118.       GOTO 23325
  1119. 23324 CONTINUE
  1120.       IF(.NOT.(OP .EQ. 45))GOTO 23326
  1121.       CALL PBNUM(CTOI(EVALST,K)-CTOI(EVALST,L))
  1122.       GOTO 23327
  1123. 23326 CONTINUE
  1124.       IF(.NOT.(OP .EQ. 42 ))GOTO 23328
  1125.       CALL PBNUM(CTOI(EVALST,K)*CTOI(EVALST,L))
  1126.       GOTO 23329
  1127. 23328 CONTINUE
  1128.       IF(.NOT.(OP .EQ. 47 ))GOTO 23330
  1129.       CALL PBNUM(CTOI(EVALST,K)/CTOI(EVALST,L))
  1130.       GOTO 23331
  1131. 23330 CONTINUE
  1132.       CALL REMARK(11HARITH ERROR)
  1133. 23331 CONTINUE
  1134. 23329 CONTINUE
  1135. 23327 CONTINUE
  1136. 23325 CONTINUE
  1137.       RETURN
  1138.       END
  1139.       SUBROUTINE DOIF(ARGSTK, I, J)
  1140.       INTEGER EQUAL
  1141.       INTEGER A2, A3, A4, A5, ARGSTK(100), I, J
  1142.       COMMON /CMACRO/ CP, EP, EVALST(500)
  1143.       INTEGER CP
  1144.       INTEGER EP
  1145.       INTEGER EVALST
  1146.       IF(.NOT.(J - I .LT. 5))GOTO 23332
  1147.       RETURN
  1148. 23332 CONTINUE
  1149.       A2 = ARGSTK(I+2)
  1150.       A3 = ARGSTK(I+3)
  1151.       A4 = ARGSTK(I+4)
  1152.       A5 = ARGSTK(I+5)
  1153.       IF(.NOT.(EQUAL(EVALST(A2), EVALST(A3)) .EQ. 1))GOTO 23334
  1154.       CALL PBSTR(EVALST(A4))
  1155.       GOTO 23335
  1156. 23334 CONTINUE
  1157.       CALL PBSTR(EVALST(A5))
  1158. 23335 CONTINUE
  1159.       RETURN
  1160.       END
  1161.       SUBROUTINE DOINCR(ARGSTK, I, J)
  1162.       INTEGER CTOI
  1163.       INTEGER ARGSTK(100), I, J, K
  1164.       COMMON /CMACRO/ CP, EP, EVALST(500)
  1165.       INTEGER CP
  1166.       INTEGER EP
  1167.       INTEGER EVALST
  1168.       K = ARGSTK(I+2)
  1169.       CALL PBNUM(CTOI(EVALST, K)+1)
  1170.       RETURN
  1171.       END
  1172.       SUBROUTINE DOSUB(ARGSTK, I, J)
  1173.       INTEGER CTOI, LENGTH
  1174.       INTEGER AP, ARGSTK(100), FC, I, J, K, NC
  1175.       COMMON /CMACRO/ CP, EP, EVALST(500)
  1176.       INTEGER CP
  1177.       INTEGER EP
  1178.       INTEGER EVALST
  1179.       IF(.NOT.(J - I .LT. 3))GOTO 23336
  1180.       RETURN
  1181. 23336 CONTINUE
  1182.       IF(.NOT.(J - I .LT. 4))GOTO 23338
  1183.       NC = 100
  1184.       GOTO 23339
  1185. 23338 CONTINUE
  1186.       K = ARGSTK(I+4)
  1187.       NC = CTOI(EVALST, K)
  1188. 23339 CONTINUE
  1189.       K = ARGSTK(I+3)
  1190.       AP = ARGSTK(I+2)
  1191.       FC = AP + CTOI(EVALST, K) - 1
  1192.       IF(.NOT.(FC .GE. AP .AND. FC .LT. AP + LENGTH(EVALST(AP))))GOTO 23
  1193.      *340
  1194.       K = FC + MIN0(NC, LENGTH(EVALST(FC))) - 1
  1195. 23342 IF(.NOT.(K .GE. FC))GOTO 23344
  1196.       CALL PUTBAK(EVALST(K))
  1197. 23343 K = K - 1
  1198.       GOTO 23342
  1199. 23344 CONTINUE
  1200. 23340 CONTINUE
  1201.       RETURN
  1202.       END
  1203.       SUBROUTINE EVALR(ARGSTK, I, J)
  1204.       INTEGER INDEX, LENGTH
  1205.       INTEGER ARGNO, ARGSTK(100), I, J, K, M, N, T, TD
  1206.       COMMON /CMACRO/ CP, EP, EVALST(500)
  1207.       INTEGER CP
  1208.       INTEGER EP
  1209.       INTEGER EVALST
  1210.       INTEGER DIGITS(11)
  1211.       DATA DIGITS(1) /48/
  1212.       DATA DIGITS(2) /49/
  1213.       DATA DIGITS(3) /50/
  1214.       DATA DIGITS(4) /51/
  1215.       DATA DIGITS(5) /52/
  1216.       DATA DIGITS(6) /53/
  1217.       DATA DIGITS(7) /54/
  1218.       DATA DIGITS(8) /55/
  1219.       DATA DIGITS(9) /56/
  1220.       DATA DIGITS(10) /57/
  1221.       DATA DIGITS(11) /10002/
  1222.       T = ARGSTK(I)
  1223.       TD = EVALST(T)
  1224.       IF(.NOT.(TD .EQ. 210))GOTO 23345
  1225.       CALL DOMAC(ARGSTK, I, J)
  1226.       GOTO 23346
  1227. 23345 CONTINUE
  1228.       IF(.NOT.(TD .EQ. 212))GOTO 23347
  1229.       CALL DOINCR(ARGSTK, I, J)
  1230.       GOTO 23348
  1231. 23347 CONTINUE
  1232.       IF(.NOT.(TD .EQ. 213))GOTO 23349
  1233.       CALL DOSUB(ARGSTK, I, J)
  1234.       GOTO 23350
  1235. 23349 CONTINUE
  1236.       IF(.NOT.(TD .EQ. 211))GOTO 23351
  1237.       CALL DOIF(ARGSTK, I, J)
  1238.       GOTO 23352
  1239. 23351 CONTINUE
  1240.       IF(.NOT.(TD .EQ. 214))GOTO 23353
  1241.       CALL DOARTH(ARGSTK, I, J)
  1242.       GOTO 23354
  1243. 23353 CONTINUE
  1244.       K = T+LENGTH(EVALST(T))-1
  1245. 23355 IF(.NOT.(K .GT. T))GOTO 23357
  1246.       IF(.NOT.(EVALST(K-1) .NE. 36))GOTO 23358
  1247.       CALL PUTBAK(EVALST(K))
  1248.       GOTO 23359
  1249. 23358 CONTINUE
  1250.       ARGNO = INDEX(DIGITS, EVALST(K)) - 1
  1251.       IF(.NOT.(ARGNO .GE. 0 .AND. ARGNO .LT. J-I))GOTO 23360
  1252.       N = I + ARGNO + 1
  1253.       M = ARGSTK(N)
  1254.       CALL PBSTR(EVALST(M))
  1255. 23360 CONTINUE
  1256.       K = K - 1
  1257. 23359 CONTINUE
  1258. 23356 K = K - 1
  1259.       GOTO 23355
  1260. 23357 CONTINUE
  1261.       IF(.NOT.(K .EQ. T))GOTO 23362
  1262.       CALL PUTBAK(EVALST(K))
  1263. 23362 CONTINUE
  1264. 23354 CONTINUE
  1265. 23352 CONTINUE
  1266. 23350 CONTINUE
  1267. 23348 CONTINUE
  1268. 23346 CONTINUE
  1269.       RETURN
  1270.       END
  1271.       INTEGER FUNCTION IFPARM(STRNG)
  1272.       INTEGER STRNG(100), C
  1273.       INTEGER I, INDEX, TYPE
  1274.       C = STRNG(1)
  1275.       IF(.NOT.(C .EQ. 212 .OR. C .EQ. 213 .OR. C .EQ. 211 .OR. C .EQ. 21
  1276.      *4 .OR. C .EQ. 210))GOTO 23364
  1277.       IFPARM = 1
  1278.       GOTO 23365
  1279. 23364 CONTINUE
  1280.       IFPARM = 0
  1281.       I=1
  1282. 23366 IF(.NOT.(INDEX(STRNG(I), 36) .GT. 0))GOTO 23368
  1283.       I = I + INDEX(STRNG(I), 36)
  1284.       IF(.NOT.(TYPE(STRNG(I)) .EQ. 2))GOTO 23369
  1285.       IF(.NOT.(TYPE(STRNG(I+1)) .NE. 2))GOTO 23371
  1286.       IFPARM = 1
  1287.       GOTO 23368
  1288. 23371 CONTINUE
  1289. 23369 CONTINUE
  1290. 23367 GOTO 23366
  1291. 23368 CONTINUE
  1292. 23365 CONTINUE
  1293.       RETURN
  1294.       END
  1295.       SUBROUTINE PBNUM(N)
  1296.       INTEGER MOD
  1297.       INTEGER M, N, NUM
  1298.       INTEGER DIGITS(11)
  1299.       DATA DIGITS(1) /48/
  1300.       DATA DIGITS(2) /49/
  1301.       DATA DIGITS(3) /50/
  1302.       DATA DIGITS(4) /51/
  1303.       DATA DIGITS(5) /52/
  1304.       DATA DIGITS(6) /53/
  1305.       DATA DIGITS(7) /54/
  1306.       DATA DIGITS(8) /55/
  1307.       DATA DIGITS(9) /56/
  1308.       DATA DIGITS(10) /57/
  1309.       DATA DIGITS(11) /10002/
  1310.       NUM = N
  1311. 23373 CONTINUE
  1312.       M = MOD(NUM, 10)
  1313.       CALL PUTBAK(DIGITS(M+1))
  1314.       NUM = NUM / 10
  1315. 23374 IF(.NOT.(NUM .EQ. 0))GOTO 23373
  1316. 23375 CONTINUE
  1317.       RETURN
  1318.       END
  1319.       INTEGER FUNCTION PUSH(EP, ARGSTK, AP)
  1320.       INTEGER AP, ARGSTK(100), EP
  1321.       IF(.NOT.(AP .GT. 100))GOTO 23376
  1322.       CALL BADERR(19HARG STACK OVERFLOW.)
  1323. 23376 CONTINUE
  1324.       ARGSTK(AP) = EP
  1325.       PUSH = AP + 1
  1326.       RETURN
  1327.       END
  1328.       SUBROUTINE PUTCHR(C)
  1329.       INTEGER C
  1330.       COMMON /CMACRO/ CP, EP, EVALST(500)
  1331.       INTEGER CP
  1332.       INTEGER EP
  1333.       INTEGER EVALST
  1334.       IF(.NOT.(EP .GT. 500))GOTO 23378
  1335.       CALL BADERR(26HEVALUATION STACK OVERFLOW.)
  1336. 23378 CONTINUE
  1337.       EVALST(EP) = C
  1338.       EP = EP + 1
  1339.       RETURN
  1340.       END
  1341.       SUBROUTINE PUTTOK(STR)
  1342.       INTEGER STR(100)
  1343.       INTEGER I
  1344.       I = 1
  1345. 23380 IF(.NOT.(STR(I) .NE. 10002))GOTO 23382
  1346.       CALL PUTCHR(STR(I))
  1347. 23381 I = I + 1
  1348.       GOTO 23380
  1349. 23382 CONTINUE
  1350.       RETURN
  1351.       END
  1352.       SUBROUTINE DOMAC(ARGSTK, I, J)
  1353.       INTEGER A2, A3, ARGSTK(100), I, J
  1354.       COMMON /CMACRO/ CP, EP, EVALST(500)
  1355.       INTEGER CP
  1356.       INTEGER EP
  1357.       INTEGER EVALST
  1358.       IF(.NOT.(J - I .GT. 2))GOTO 23383
  1359.       A2 = ARGSTK(I+2)
  1360.       A3 = ARGSTK(I+3)
  1361.       CALL INSTAL(EVALST(A2), EVALST(A3))
  1362. 23383 CONTINUE
  1363.       RETURN
  1364.       END
  1365.       SUBROUTINE RAT4
  1366.       INTEGER GETARG, OPEN
  1367.       INTEGER BUF(30)
  1368.       INTEGER I, N
  1369.       COMMON /CLINE/ RATLST, LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES(
  1370.      * 90)
  1371.       INTEGER RATLST
  1372.       INTEGER LEVEL
  1373.       INTEGER LINECT
  1374.       INTEGER INFILE
  1375.       INTEGER FNAMP
  1376.       INTEGER FNAMES
  1377.       INTEGER DEFNS(1)
  1378.       DATA DEFNS(1)/10002/
  1379.       CALL INITKW
  1380.       IF(.NOT.(DEFNS(1) .NE. 10002))GOTO 23385
  1381.       CALL SCOPY(DEFNS, 1, BUF, 1)
  1382.       INFILE(1) = OPEN(BUF, 1)
  1383.       IF(.NOT.(INFILE(1) .EQ. 10001))GOTO 23387
  1384.       CALL REMARK (37HCAN'T OPEN STANDARD DEFINITIONS FILE.)
  1385.       GOTO 23388
  1386. 23387 CONTINUE
  1387.       CALL PARSE
  1388.       CALL CLOSE (INFILE(1))
  1389. 23388 CONTINUE
  1390. 23385 CONTINUE
  1391.       N = 1
  1392.       I=1
  1393. 23389 IF(.NOT.(GETARG(I, BUF, 30) .NE. 10003))GOTO 23391
  1394.       N = N + 1
  1395.       IF(.NOT.(BUF(1) .EQ. 63 .AND. BUF(2) .EQ. 10002))GOTO 23392
  1396.       CALL ERROR (38HUSAGE:  RAT4 [-L] [FILE ...] >OUTFILE.)
  1397.       GOTO 23393
  1398. 23392 CONTINUE
  1399.       IF(.NOT.(BUF(1) .EQ. 45 .AND. BUF(2) .EQ. 10002))GOTO 23394
  1400.       INFILE(1) = 1
  1401.       GOTO 23395
  1402. 23394 CONTINUE
  1403.       IF(.NOT.(BUF(1) .EQ. 45 .AND. (BUF(2) .EQ. 108 .OR. BUF(2) .EQ. 76
  1404.      *)))GOTO 23396
  1405.       RATLST = 1
  1406.       N = N - 1
  1407.       GOTO 23397
  1408. 23396 CONTINUE
  1409.       INFILE(1) = OPEN(BUF, 1)
  1410.       IF(.NOT.(INFILE(1) .EQ. 10001))GOTO 23398
  1411.       CALL CANT(BUF)
  1412. 23398 CONTINUE
  1413. 23397 CONTINUE
  1414. 23395 CONTINUE
  1415. 23393 CONTINUE
  1416.       CALL PARSE
  1417.       IF(.NOT.(INFILE(1) .NE. 1))GOTO 23400
  1418.       CALL CLOSE(INFILE(1))
  1419. 23400 CONTINUE
  1420. 23390 I=I+1
  1421.       GOTO 23389
  1422. 23391 CONTINUE
  1423.       IF(.NOT.(N .EQ. 1))GOTO 23402
  1424.       INFILE(1) = 1
  1425.       CALL PARSE
  1426. 23402 CONTINUE
  1427.       RETURN
  1428.       END
  1429.       SUBROUTINE EATUP
  1430.       INTEGER GETTOK
  1431.       INTEGER PTOKEN(100), T, TOKEN(100)
  1432.       INTEGER NLPAR
  1433.       NLPAR = 0
  1434. 23404 CONTINUE
  1435.       T = GETTOK(TOKEN, 100)
  1436.       IF(.NOT.(T .EQ. 59 .OR. T .EQ. 10))GOTO 23407
  1437.       GOTO 23406
  1438. 23407 CONTINUE
  1439.       IF(.NOT.(T .EQ. 125 .OR. T .EQ. 123))GOTO 23409
  1440.       CALL PBSTR(TOKEN)
  1441.       GOTO 23406
  1442. 23409 CONTINUE
  1443.       IF(.NOT.(T .EQ. 10003))GOTO 23411
  1444.       CALL SYNERR(15HUNEXPECTED EOF.)
  1445.       CALL PBSTR(TOKEN)
  1446.       GOTO 23406
  1447. 23411 CONTINUE
  1448.       IF(.NOT.(T .EQ. 44 .OR. T .EQ. 43 .OR. T .EQ. 45 .OR. T .EQ. 42 .O
  1449.      *R. T .EQ. 40 .OR. T .EQ. 38 .OR. T .EQ. 124 .OR. T .EQ. 33 .OR. T
  1450.      *.EQ. 126 .OR. T .EQ. 33 .OR. T .EQ. 94 .OR. T .EQ. 61 .OR. T .EQ.
  1451.      *95))GOTO 23413
  1452. 23415 IF(.NOT.(GETTOK(PTOKEN, 100) .EQ. 10))GOTO 23416
  1453.       GOTO 23415
  1454. 23416 CONTINUE
  1455.       CALL PBSTR(PTOKEN)
  1456.       IF(.NOT.(T .EQ. 95))GOTO 23417
  1457.       TOKEN(1) = 10002
  1458. 23417 CONTINUE
  1459. 23413 CONTINUE
  1460.       IF(.NOT.(T .EQ. 40))GOTO 23419
  1461.       NLPAR = NLPAR + 1
  1462.       GOTO 23420
  1463. 23419 CONTINUE
  1464.       IF(.NOT.(T .EQ. 41))GOTO 23421
  1465.       NLPAR = NLPAR - 1
  1466. 23421 CONTINUE
  1467. 23420 CONTINUE
  1468.       CALL OUTSTR(TOKEN)
  1469. 23405 IF(.NOT.(NLPAR .LT. 0))GOTO 23404
  1470. 23406 CONTINUE
  1471.       IF(.NOT.(NLPAR .NE. 0))GOTO 23423
  1472.       CALL SYNERR(23HUNBALANCED PARENTHESES.)
  1473. 23423 CONTINUE
  1474.       RETURN
  1475.       END
  1476.       SUBROUTINE LABELC(LEXSTR)
  1477.       INTEGER LEXSTR(100)
  1478.       INTEGER LENGTH
  1479.       COMMON /CGOTO/ XFER
  1480.       INTEGER XFER
  1481.       XFER = 0
  1482.       IF(.NOT.(LENGTH(LEXSTR) .EQ. 5))GOTO 23425
  1483.       IF(.NOT.(LEXSTR(1) .EQ. 50 .AND. LEXSTR(2) .EQ. 51))GOTO 23427
  1484.       CALL SYNERR(33HWARNING: POSSIBLE LABEL CONFLICT.)
  1485. 23427 CONTINUE
  1486. 23425 CONTINUE
  1487.       CALL OUTSTR(LEXSTR)
  1488.       CALL OUTTAB
  1489.       RETURN
  1490.       END
  1491.       SUBROUTINE OTHERC(LEXSTR)
  1492.       INTEGER LEXSTR(100)
  1493.       COMMON /CGOTO/ XFER
  1494.       INTEGER XFER
  1495.       XFER = 0
  1496.       CALL OUTTAB
  1497.       CALL OUTSTR(LEXSTR)
  1498.       CALL EATUP
  1499.       CALL OUTDON
  1500.       RETURN
  1501.       END
  1502.       SUBROUTINE OUTCH(C)
  1503.       INTEGER C
  1504.       INTEGER I
  1505.       COMMON /COUTLN/ OUTP, OUTBUF(74)
  1506.       INTEGER OUTP
  1507.       INTEGER OUTBUF
  1508.       IF(.NOT.(OUTP .GE. 72))GOTO 23429
  1509.       CALL OUTDON
  1510.       I = 1
  1511. 23431 IF(.NOT.(I .LT. 6))GOTO 23433
  1512.       OUTBUF(I) = 32
  1513. 23432 I = I + 1
  1514.       GOTO 23431
  1515. 23433 CONTINUE
  1516.       OUTBUF(6) = 42
  1517.       OUTP = 6
  1518. 23429 CONTINUE
  1519.       OUTP = OUTP + 1
  1520.       OUTBUF(OUTP) = C
  1521.       RETURN
  1522.       END
  1523.       SUBROUTINE OUTCON(N)
  1524.       INTEGER N
  1525.       COMMON /CGOTO/ XFER
  1526.       INTEGER XFER
  1527.       COMMON /COUTLN/ OUTP, OUTBUF(74)
  1528.       INTEGER OUTP
  1529.       INTEGER OUTBUF
  1530.       INTEGER CONTIN(9)
  1531.       DATA CONTIN(1)/99/,CONTIN(2)/111/,CONTIN(3)/110/,CONTIN(4)/116/,CO
  1532.      *NTIN(5)/105/,CONTIN(6)/110/,CONTIN(7)/117/,CONTIN(8)/101/,CONTIN(9
  1533.      *)/10002/
  1534.       XFER = 0
  1535.       IF(.NOT.(N .LE. 0 .AND. OUTP .EQ. 0))GOTO 23434
  1536.       RETURN
  1537. 23434 CONTINUE
  1538.       IF(.NOT.(N .GT. 0))GOTO 23436
  1539.       CALL OUTNUM(N)
  1540. 23436 CONTINUE
  1541.       CALL OUTTAB
  1542.       CALL OUTSTR(CONTIN)
  1543.       CALL OUTDON
  1544.       RETURN
  1545.       END
  1546.       SUBROUTINE OUTDON
  1547.       INTEGER ALLBLK
  1548.       COMMON /COUTLN/ OUTP, OUTBUF(74)
  1549.       INTEGER OUTP
  1550.       INTEGER OUTBUF
  1551.       OUTBUF(OUTP+1) = 10
  1552.       OUTBUF(OUTP+2) = 10002
  1553.       IF(.NOT.(ALLBLK(OUTBUF) .EQ. 0))GOTO 23438
  1554.       CALL PUTLIN(OUTBUF, 2)
  1555. 23438 CONTINUE
  1556.       OUTP = 0
  1557.       RETURN
  1558.       END
  1559.       SUBROUTINE OUTGO(N)
  1560.       INTEGER N
  1561.       COMMON /CGOTO/ XFER
  1562.       INTEGER XFER
  1563.       INTEGER GOTO(6)
  1564.       DATA GOTO(1)/103/,GOTO(2)/111/,GOTO(3)/116/,GOTO(4)/111/,GOTO(5)/3
  1565.      *2/,GOTO(6)/10002/
  1566.       IF(.NOT.(XFER .EQ. 1))GOTO 23440
  1567.       RETURN
  1568. 23440 CONTINUE
  1569.       CALL OUTTAB
  1570.       CALL OUTSTR(GOTO)
  1571.       CALL OUTNUM(N)
  1572.       CALL OUTDON
  1573.       RETURN
  1574.       END
  1575.       SUBROUTINE OUTNUM(N)
  1576.       INTEGER CHARS(20)
  1577.       INTEGER I, M
  1578.       M = IABS(N)
  1579.       I = 0
  1580. 23442 CONTINUE
  1581.       I = I + 1
  1582.       CHARS(I) = MOD(M, 10) + 48
  1583.       M = M / 10
  1584. 23443 IF(.NOT.(M .EQ. 0 .OR. I .GE. 20))GOTO 23442
  1585. 23444 CONTINUE
  1586.       IF(.NOT.(N .LT. 0))GOTO 23445
  1587.       CALL OUTCH(45)
  1588. 23445 CONTINUE
  1589. 23447 IF(.NOT.(I .GT. 0))GOTO 23449
  1590.       CALL OUTCH(CHARS(I))
  1591. 23448 I = I - 1
  1592.       GOTO 23447
  1593. 23449 CONTINUE
  1594.       RETURN
  1595.       END
  1596.       SUBROUTINE OUTSTR(STR)
  1597.       INTEGER C, STR(100)
  1598.       INTEGER I, J
  1599.       I = 1
  1600. 23450 IF(.NOT.(STR(I) .NE. 10002))GOTO 23452
  1601.       C = STR(I)
  1602.       IF(.NOT.(C .NE. 39 .AND. C .NE. 34))GOTO 23453
  1603.       IF(.NOT.(C .GE. 97 .AND. C .LE. 122))GOTO 23455
  1604.       C = C - 97 + 65
  1605. 23455 CONTINUE
  1606.       CALL OUTCH(C)
  1607.       GOTO 23454
  1608. 23453 CONTINUE
  1609.       I = I + 1
  1610.       J = I
  1611. 23457 IF(.NOT.(STR(J) .NE. C))GOTO 23459
  1612. 23458 J = J + 1
  1613.       GOTO 23457
  1614. 23459 CONTINUE
  1615.       CALL OUTNUM(J-I)
  1616.       CALL OUTCH(72)
  1617. 23460 IF(.NOT.(I .LT. J))GOTO 23462
  1618.       CALL OUTCH(STR(I))
  1619. 23461 I = I + 1
  1620.       GOTO 23460
  1621. 23462 CONTINUE
  1622. 23454 CONTINUE
  1623. 23451 I = I + 1
  1624.       GOTO 23450
  1625. 23452 CONTINUE
  1626.       RETURN
  1627.       END
  1628.       SUBROUTINE OUTTAB
  1629.       COMMON /COUTLN/ OUTP, OUTBUF(74)
  1630.       INTEGER OUTP
  1631.       INTEGER OUTBUF
  1632. 23463 IF(.NOT.(OUTP .LT. 6))GOTO 23464
  1633.       CALL OUTCH(32)
  1634.       GOTO 23463
  1635. 23464 CONTINUE
  1636.       RETURN
  1637.       END
  1638.       INTEGER FUNCTION ALLBLK(BUF)
  1639.       INTEGER BUF(100)
  1640.       INTEGER I
  1641.       ALLBLK = 1
  1642.       I=1
  1643. 23465 IF(.NOT.(BUF(I) .NE. 10 .AND. BUF(I) .NE. 10002))GOTO 23467
  1644.       IF(.NOT.(BUF(I) .NE. 32))GOTO 23468
  1645.       ALLBLK = 0
  1646.       GOTO 23467
  1647. 23468 CONTINUE
  1648. 23466 I=I+1
  1649.       GOTO 23465
  1650. 23467 CONTINUE
  1651.       RETURN
  1652.       END
  1653.       SUBROUTINE INITKW
  1654.       INTEGER DEFT(2), INCT(2), SUBT(2), IFT(2), ART(2), IFDFT(2), IFNDT
  1655.      *(2), MACT(2)
  1656.       COMMON /CLABEL/ LABEL
  1657.       INTEGER LABEL
  1658.       COMMON /CLINE/ RATLST, LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES(
  1659.      * 90)
  1660.       INTEGER RATLST
  1661.       INTEGER LEVEL
  1662.       INTEGER LINECT
  1663.       INTEGER INFILE
  1664.       INTEGER FNAMP
  1665.       INTEGER FNAMES
  1666.       INTEGER DEFNAM(7)
  1667.       INTEGER MACNAM(8)
  1668.       INTEGER INCNAM(5)
  1669.       INTEGER SUBNAM(7)
  1670.       INTEGER IFNAM(7)
  1671.       INTEGER ARNAM(6)
  1672.       INTEGER IFDFNM(6)
  1673.       INTEGER IFNDNM(9)
  1674.       DATA DEFNAM(1)/100/,DEFNAM(2)/101/,DEFNAM(3)/102/,DEFNAM(4)/105/,D
  1675.      *EFNAM(5)/110/,DEFNAM(6)/101/,DEFNAM(7)/10002/
  1676.       DATA MACNAM(1)/109/,MACNAM(2)/100/,MACNAM(3)/101/,MACNAM(4)/102/,M
  1677.      *ACNAM(5)/105/,MACNAM(6)/110/,MACNAM(7)/101/,MACNAM(8)/10002/
  1678.       DATA INCNAM(1)/105/,INCNAM(2)/110/,INCNAM(3)/99/,INCNAM(4)/114/,IN
  1679.      *CNAM(5)/10002/
  1680.       DATA SUBNAM(1)/115/,SUBNAM(2)/117/,SUBNAM(3)/98/,SUBNAM(4)/115/,SU
  1681.      *BNAM(5)/116/,SUBNAM(6)/114/,SUBNAM(7)/10002/
  1682.       DATA IFNAM(1)/105/,IFNAM(2)/102/,IFNAM(3)/101/,IFNAM(4)/108/,IFNAM
  1683.      *(5)/115/,IFNAM(6)/101/,IFNAM(7)/10002/
  1684.       DATA ARNAM(1)/97/,ARNAM(2)/114/,ARNAM(3)/105/,ARNAM(4)/116/,ARNAM(
  1685.      *5)/104/,ARNAM(6)/10002/
  1686.       DATA IFDFNM(1)/105/,IFDFNM(2)/102/,IFDFNM(3)/100/,IFDFNM(4)/101/,I
  1687.      *FDFNM(5)/102/,IFDFNM(6)/10002/
  1688.       DATA IFNDNM(1)/105/,IFNDNM(2)/102/,IFNDNM(3)/110/,IFNDNM(4)/111/,I
  1689.      *FNDNM(5)/116/,IFNDNM(6)/100/,IFNDNM(7)/101/,IFNDNM(8)/102/,IFNDNM(
  1690.      *9)/10002/
  1691.       DATA DEFT(1), DEFT(2) /10010, 10002/
  1692.       DATA MACT(1), MACT(2) /210, 10002/
  1693.       DATA INCT(1), INCT(2) /212, 10002/
  1694.       DATA SUBT(1), SUBT(2) /213, 10002/
  1695.       DATA IFT(1), IFT(2) /211, 10002/
  1696.       DATA ART(1), ART(2) /214, 10002/
  1697.       DATA IFDFT(1), IFDFT(2) /215, 10002/
  1698.       DATA IFNDT(1), IFNDT(2) /216, 10002/
  1699.       CALL TBINIT
  1700.       CALL ULSTAL(DEFNAM, DEFT)
  1701.       CALL ULSTAL(MACNAM, MACT)
  1702.       CALL ULSTAL(INCNAM, INCT)
  1703.       CALL ULSTAL(SUBNAM, SUBT)
  1704.       CALL ULSTAL(IFNAM, IFT)
  1705.       CALL ULSTAL(ARNAM, ART)
  1706.       CALL ULSTAL(IFDFNM, IFDFT)
  1707.       CALL ULSTAL(IFNDNM, IFNDT)
  1708.       LABEL = 23000
  1709.       RATLST = 0
  1710.       RETURN
  1711.       END
  1712.       SUBROUTINE INIT
  1713.       INTEGER I
  1714.       COMMON /COUTLN/ OUTP, OUTBUF(74)
  1715.       INTEGER OUTP
  1716.       INTEGER OUTBUF
  1717.       COMMON /CLINE/ RATLST, LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES(
  1718.      * 90)
  1719.       INTEGER RATLST
  1720.       INTEGER LEVEL
  1721.       INTEGER LINECT
  1722.       INTEGER INFILE
  1723.       INTEGER FNAMP
  1724.       INTEGER FNAMES
  1725.       COMMON /CDEFIO/ BP, BUF(300)
  1726.       INTEGER BP
  1727.       INTEGER BUF
  1728.       COMMON /CFOR/ FORDEP, FORSTK(200)
  1729.       INTEGER FORDEP
  1730.       INTEGER FORSTK
  1731.       COMMON /CFNAME/ FCNAME(30)
  1732.       INTEGER FCNAME
  1733.       COMMON /CLABEL/ LABEL
  1734.       INTEGER LABEL
  1735.       COMMON /CSBUF/ SBP, SBUF(500)
  1736.       INTEGER SBP
  1737.       INTEGER SBUF
  1738.       COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK(1000)
  1739.       INTEGER SWTOP
  1740.       INTEGER SWLAST
  1741.       INTEGER SWSTAK
  1742.       OUTP = 0
  1743.       LEVEL = 1
  1744.       LINECT(1) = 1
  1745.       SBP = 1
  1746.       FNAMP = 2
  1747.       FNAMES(1) = 10002
  1748.       BP = 0
  1749.       FORDEP = 0
  1750.       FCNAME(1) = 10002
  1751.       SWTOP = 0
  1752.       SWLAST = 1
  1753.       RETURN
  1754.       END
  1755.       SUBROUTINE PARSE
  1756.       INTEGER LEXSTR(100)
  1757.       INTEGER LEX
  1758.       INTEGER LAB, LABVAL(100), LEXTYP(100), SP, TOKEN, I
  1759.       COMMON /CGOTO/ XFER
  1760.       INTEGER XFER
  1761.       COMMON /CFOR/ FORDEP, FORSTK(200)
  1762.       INTEGER FORDEP
  1763.       INTEGER FORSTK
  1764.       COMMON /CFNAME/ FCNAME(30)
  1765.       INTEGER FCNAME
  1766.       COMMON /CLINE/ RATLST, LEVEL, LINECT(3), INFILE(3), FNAMP, FNAMES(
  1767.      * 90)
  1768.       INTEGER RATLST
  1769.       INTEGER LEVEL
  1770.       INTEGER LINECT
  1771.       INTEGER INFILE
  1772.       INTEGER FNAMP
  1773.       INTEGER FNAMES
  1774.       COMMON /CSBUF/ SBP, SBUF(500)
  1775.       INTEGER SBP
  1776.       INTEGER SBUF
  1777.       COMMON /CLABEL/ LABEL
  1778.       INTEGER LABEL
  1779.       COMMON /CDEFIO/ BP, BUF(300)
  1780.       INTEGER BP
  1781.       INTEGER BUF
  1782.       COMMON /COUTLN/ OUTP, OUTBUF(74)
  1783.       INTEGER OUTP
  1784.       INTEGER OUTBUF
  1785.       CALL INIT
  1786.       SP = 1
  1787.       LEXTYP(1) = 10003
  1788.       TOKEN = LEX(LEXSTR)
  1789. 23470 IF(.NOT.(TOKEN .NE. 10003))GOTO 23472
  1790.       IF(.NOT.(TOKEN .EQ. 10261))GOTO 23473
  1791.       CALL IFCODE(LAB)
  1792.       GOTO 23474
  1793. 23473 CONTINUE
  1794.       IF(.NOT.(TOKEN .EQ. 10266))GOTO 23475
  1795.       CALL DOCODE(LAB)
  1796.       GOTO 23476
  1797. 23475 CONTINUE
  1798.       IF(.NOT.(TOKEN .EQ. 10263))GOTO 23477
  1799.       CALL WHILEC(LAB)
  1800.       GOTO 23478
  1801. 23477 CONTINUE
  1802.       IF(.NOT.(TOKEN .EQ. 10268))GOTO 23479
  1803.       CALL FORCOD(LAB)
  1804.       GOTO 23480
  1805. 23479 CONTINUE
  1806.       IF(.NOT.(TOKEN .EQ. 10269))GOTO 23481
  1807.       CALL REPCOD(LAB)
  1808.       GOTO 23482
  1809. 23481 CONTINUE
  1810.       IF(.NOT.(TOKEN .EQ. 10275))GOTO 23483
  1811.       CALL SWCODE(LAB)
  1812.       GOTO 23484
  1813. 23483 CONTINUE
  1814.       IF(.NOT.(TOKEN .EQ. 10276 .OR. TOKEN .EQ. 10277))GOTO 23485
  1815.       I = SP
  1816. 23487 IF(.NOT.(I .GT. 0))GOTO 23489
  1817.       IF(.NOT.(LEXTYP(I) .EQ. 10275))GOTO 23490
  1818.       GOTO 23489
  1819. 23490 CONTINUE
  1820. 23488 I = I - 1
  1821.       GOTO 23487
  1822. 23489 CONTINUE
  1823.       IF(.NOT.(I .EQ. 0))GOTO 23492
  1824.       CALL SYNERR(24HILLEGAL CASE OR DEFAULT.)
  1825.       GOTO 23493
  1826. 23492 CONTINUE
  1827.       CALL CASCOD(LABVAL(I), TOKEN)
  1828. 23493 CONTINUE
  1829.       GOTO 23486
  1830. 23485 CONTINUE
  1831.       IF(.NOT.(TOKEN .EQ. 10260))GOTO 23494
  1832.       CALL LABELC(LEXSTR)
  1833.       GOTO 23495
  1834. 23494 CONTINUE
  1835.       IF(.NOT.(TOKEN .EQ. 10262))GOTO 23496
  1836.       IF(.NOT.(LEXTYP(SP) .EQ. 10261))GOTO 23498
  1837.       CALL ELSEIF(LABVAL(SP))
  1838.       GOTO 23499
  1839. 23498 CONTINUE
  1840.       CALL SYNERR(13HILLEGAL ELSE.)
  1841. 23499 CONTINUE
  1842.       GOTO 23497
  1843. 23496 CONTINUE
  1844.       IF(.NOT.(TOKEN .EQ. 10278))GOTO 23500
  1845.       CALL LITRAL
  1846. 23500 CONTINUE
  1847. 23497 CONTINUE
  1848. 23495 CONTINUE
  1849. 23486 CONTINUE
  1850. 23484 CONTINUE
  1851. 23482 CONTINUE
  1852. 23480 CONTINUE
  1853. 23478 CONTINUE
  1854. 23476 CONTINUE
  1855. 23474 CONTINUE
  1856.       IF(.NOT.(TOKEN .EQ. 10261 .OR. TOKEN .EQ. 10262 .OR. TOKEN .EQ. 10
  1857.      *263 .OR. TOKEN .EQ. 10268 .OR. TOKEN .EQ. 10269 .OR. TOKEN .EQ. 10
  1858.      *275 .OR. TOKEN .EQ. 10266 .OR. TOKEN .EQ. 10260 .OR. TOKEN .EQ. 12
  1859.      *3))GOTO 23502
  1860.       SP = SP + 1
  1861.       IF(.NOT.(SP .GT. 100))GOTO 23504
  1862.       CALL BADERR(25HSTACK OVERFLOW IN PARSER.)
  1863. 23504 CONTINUE
  1864.       LEXTYP(SP) = TOKEN
  1865.       LABVAL(SP) = LAB
  1866.       GOTO 23503
  1867. 23502 CONTINUE
  1868.       IF(.NOT.(TOKEN .NE. 10276 .AND. TOKEN .NE. 10277))GOTO 23506
  1869.       IF(.NOT.(TOKEN .EQ. 125))GOTO 23508
  1870.       IF(.NOT.(LEXTYP(SP) .EQ. 123))GOTO 23510
  1871.       SP = SP - 1
  1872.       GOTO 23511
  1873. 23510 CONTINUE
  1874.       IF(.NOT.(LEXTYP(SP) .EQ. 10275))GOTO 23512
  1875.       CALL SWEND(LABVAL(SP))
  1876.       SP = SP - 1
  1877.       GOTO 23513
  1878. 23512 CONTINUE
  1879.       CALL SYNERR(20HILLEGAL RIGHT BRACE.)
  1880. 23513 CONTINUE
  1881. 23511 CONTINUE
  1882.       GOTO 23509
  1883. 23508 CONTINUE
  1884.       IF(.NOT.(TOKEN .EQ. 10267))GOTO 23514
  1885.       CALL OTHERC(LEXSTR)
  1886.       GOTO 23515
  1887. 23514 CONTINUE
  1888.       IF(.NOT.(TOKEN .EQ. 10264 .OR. TOKEN .EQ. 10265))GOTO 23516
  1889.       CALL BRKNXT(SP, LEXTYP, LABVAL, TOKEN)
  1890.       GOTO 23517
  1891. 23516 CONTINUE
  1892.       IF(.NOT.(TOKEN .EQ. 10271))GOTO 23518
  1893.       CALL RETCOD
  1894.       GOTO 23519
  1895. 23518 CONTINUE
  1896.       IF(.NOT.(TOKEN .EQ. 10274))GOTO 23520
  1897.       CALL STRDCL
  1898. 23520 CONTINUE
  1899. 23519 CONTINUE
  1900. 23517 CONTINUE
  1901. 23515 CONTINUE
  1902. 23509 CONTINUE
  1903.       TOKEN = LEX(LEXSTR)
  1904.       CALL PBSTR(LEXSTR)
  1905.       CALL UNSTAK(SP, LEXTYP, LABVAL, TOKEN)
  1906. 23506 CONTINUE
  1907. 23503 CONTINUE
  1908. 23471 TOKEN = LEX(LEXSTR)
  1909.       GOTO 23470
  1910. 23472 CONTINUE
  1911.       IF(.NOT.(SP .NE. 1))GOTO 23522
  1912.       CALL SYNERR(15HUNEXPECTED EOF.)
  1913. 23522 CONTINUE
  1914.       RETURN
  1915.       END
  1916.       SUBROUTINE UNSTAK(SP, LEXTYP, LABVAL, TOKEN)
  1917.       INTEGER LABVAL(100), LEXTYP(100), SP, TOKEN
  1918. 23524 IF(.NOT.(SP .GT. 1))GOTO 23526
  1919.       IF(.NOT.(LEXTYP(SP) .EQ. 123 .OR. LEXTYP(SP) .EQ. 10275))GOTO 2352
  1920.      *7
  1921.       GOTO 23526
  1922. 23527 CONTINUE
  1923.       IF(.NOT.(LEXTYP(SP) .EQ. 10261 .AND. TOKEN .EQ. 10262))GOTO 23529
  1924.       GOTO 23526
  1925. 23529 CONTINUE
  1926.       IF(.NOT.(LEXTYP(SP) .EQ. 10261))GOTO 23531
  1927.       CALL OUTCON(LABVAL(SP))
  1928.       GOTO 23532
  1929. 23531 CONTINUE
  1930.       IF(.NOT.(LEXTYP(SP) .EQ. 10262))GOTO 23533
  1931.       IF(.NOT.(SP .GT. 2))GOTO 23535
  1932.       SP = SP - 1
  1933. 23535 CONTINUE
  1934.       CALL OUTCON(LABVAL(SP)+1)
  1935.       GOTO 23534
  1936. 23533 CONTINUE
  1937.       IF(.NOT.(LEXTYP(SP) .EQ. 10266))GOTO 23537
  1938.       CALL DOSTAT(LABVAL(SP))
  1939.       GOTO 23538
  1940. 23537 CONTINUE
  1941.       IF(.NOT.(LEXTYP(SP) .EQ. 10263))GOTO 23539
  1942.       CALL WHILES(LABVAL(SP))
  1943.       GOTO 23540
  1944. 23539 CONTINUE
  1945.       IF(.NOT.(LEXTYP(SP) .EQ. 10268))GOTO 23541
  1946.       CALL FORS(LABVAL(SP))
  1947.       GOTO 23542
  1948. 23541 CONTINUE
  1949.       IF(.NOT.(LEXTYP(SP) .EQ. 10269))GOTO 23543
  1950.       CALL UNTILS(LABVAL(SP), TOKEN)
  1951. 23543 CONTINUE
  1952. 23542 CONTINUE
  1953. 23540 CONTINUE
  1954. 23538 CONTINUE
  1955. 23534 CONTINUE
  1956. 23532 CONTINUE
  1957. 23525 SP = SP - 1
  1958.       GOTO 23524
  1959. 23526 CONTINUE
  1960.       RETURN
  1961.       END
  1962.       SUBROUTINE ULSTAL(NAME, DEFN)
  1963.       INTEGER NAME(100), DEFN(100)
  1964.       CALL INSTAL(NAME, DEFN)
  1965.       CALL UPPER(NAME)
  1966.       CALL INSTAL(NAME, DEFN)
  1967.       RETURN
  1968.       END
  1969.       SUBROUTINE REPCOD(LAB)
  1970.       INTEGER LABGEN
  1971.       INTEGER LAB
  1972.       CALL OUTCON(0)
  1973.       LAB = LABGEN(3)
  1974.       CALL OUTCON(LAB)
  1975.       LAB = LAB + 1
  1976.       RETURN
  1977.       END
  1978.       SUBROUTINE UNTILS(LAB, TOKEN)
  1979.       INTEGER PTOKEN(100)
  1980.       INTEGER LEX
  1981.       INTEGER JUNK, LAB, TOKEN
  1982.       COMMON /CGOTO/ XFER
  1983.       INTEGER XFER
  1984.       XFER = 0
  1985.       CALL OUTNUM(LAB)
  1986.       IF(.NOT.(TOKEN .EQ. 10270))GOTO 23545
  1987.       JUNK = LEX(PTOKEN)
  1988.       CALL IFGO(LAB-1)
  1989.       GOTO 23546
  1990. 23545 CONTINUE
  1991.       CALL OUTGO(LAB-1)
  1992. 23546 CONTINUE
  1993.       CALL OUTCON(LAB+1)
  1994.       RETURN
  1995.       END
  1996.       SUBROUTINE RETCOD
  1997.       INTEGER TOKEN(100), GNBTOK, T
  1998.       COMMON /CFNAME/ FCNAME(30)
  1999.       INTEGER FCNAME
  2000.       COMMON /CGOTO/ XFER
  2001.       INTEGER XFER
  2002.       INTEGER SRET(7)
  2003.       DATA SRET(1)/114/,SRET(2)/101/,SRET(3)/116/,SRET(4)/117/,SRET(5)/1
  2004.      *14/,SRET(6)/110/,SRET(7)/10002/
  2005.       T = GNBTOK(TOKEN, 100)
  2006.       IF(.NOT.(T .NE. 10 .AND. T .NE. 59 .AND. T .NE. 125))GOTO 23547
  2007.       CALL PBSTR(TOKEN)
  2008.       CALL OUTTAB
  2009.       CALL OUTSTR(FCNAME)
  2010.       CALL OUTCH(61)
  2011.       CALL EATUP
  2012.       CALL OUTDON
  2013.       GOTO 23548
  2014. 23547 CONTINUE
  2015.       IF(.NOT.(T .EQ. 125))GOTO 23549
  2016.       CALL PBSTR(TOKEN)
  2017. 23549 CONTINUE
  2018. 23548 CONTINUE
  2019.       CALL OUTTAB
  2020.       CALL OUTSTR(SRET)
  2021.       CALL OUTDON
  2022.       XFER = 1
  2023.       RETURN
  2024.       END
  2025.       SUBROUTINE STRDCL
  2026.       INTEGER T, TOKEN(100), GNBTOK
  2027.       INTEGER I, J, K, N, LEN
  2028.       INTEGER LENGTH, CTOI, LEX
  2029.       INTEGER DCHAR(100)
  2030.       COMMON /CSBUF/ SBP, SBUF(500)
  2031.       INTEGER SBP
  2032.       INTEGER SBUF
  2033.       INTEGER CHAR(11)
  2034.       INTEGER DAT(6)
  2035.       INTEGER EOSS(5)
  2036.       DATA CHAR(1)/99/,CHAR(2)/104/,CHAR(3)/97/,CHAR(4)/114/,CHAR(5)/97/
  2037.      *,CHAR(6)/99/,CHAR(7)/116/,CHAR(8)/101/,CHAR(9)/114/,CHAR(10)/47/,C
  2038.      *HAR(11)/10002/
  2039.       DATA DAT(1)/100/,DAT(2)/97/,DAT(3)/116/,DAT(4)/97/,DAT(5)/32/,DAT(
  2040.      *6)/10002/
  2041.       DATA EOSS(1)/69/,EOSS(2)/79/,EOSS(3)/83/,EOSS(4)/47/,EOSS(5)/10002
  2042.      */
  2043.       T = GNBTOK(TOKEN, 100)
  2044.       IF(.NOT.(T .NE. 10100))GOTO 23551
  2045.       CALL SYNERR(21HMISSING STRING TOKEN.)
  2046. 23551 CONTINUE
  2047.       CALL OUTTAB
  2048.       CALL PBSTR(CHAR)
  2049. 23553 CONTINUE
  2050.       T = GNBTOK(DCHAR, 100)
  2051.       IF(.NOT.(T .EQ. 47))GOTO 23556
  2052.       GOTO 23555
  2053. 23556 CONTINUE
  2054.       CALL OUTSTR (DCHAR)
  2055. 23554 GOTO 23553
  2056. 23555 CONTINUE
  2057.       CALL OUTCH(32)
  2058.       CALL OUTSTR(TOKEN)
  2059.       CALL ADDSTR(TOKEN, SBUF, SBP, 500)
  2060.       CALL ADDCHR(10002, SBUF, SBP, 500)
  2061.       IF(.NOT.(GNBTOK(TOKEN, 100) .NE. 40))GOTO 23558
  2062.       LEN = LENGTH(TOKEN) + 1
  2063.       IF(.NOT.(TOKEN(1) .EQ. 39 .OR. TOKEN(1) .EQ. 34))GOTO 23560
  2064.       LEN = LEN - 2
  2065. 23560 CONTINUE
  2066.       GOTO 23559
  2067. 23558 CONTINUE
  2068.       T = GNBTOK(TOKEN, 100)
  2069.       I = 1
  2070.       LEN = CTOI(TOKEN, I)
  2071.       IF(.NOT.(TOKEN(I) .NE. 10002))GOTO 23562
  2072.       CALL SYNERR(20HINVALID STRING SIZE.)
  2073. 23562 CONTINUE
  2074.       IF(.NOT.(GNBTOK(TOKEN, 100) .NE. 41))GOTO 23564
  2075.       CALL SYNERR(20HMISSING RIGHT PAREN.)
  2076.       GOTO 23565
  2077. 23564 CONTINUE
  2078.       T = GNBTOK(TOKEN, 100)
  2079. 23565 CONTINUE
  2080. 23559 CONTINUE
  2081.       CALL OUTCH(40)
  2082.       CALL OUTNUM(LEN)
  2083.       CALL OUTCH(41)
  2084.       CALL OUTDON
  2085.       IF(.NOT.(TOKEN(1) .EQ. 39 .OR. TOKEN(1) .EQ. 34))GOTO 23566
  2086.       LEN = LENGTH(TOKEN)
  2087.       TOKEN(LEN) = 10002
  2088.       CALL ADDSTR(TOKEN(2), SBUF, SBP, 500)
  2089.       GOTO 23567
  2090. 23566 CONTINUE
  2091.       CALL ADDSTR(TOKEN, SBUF, SBP, 500)
  2092. 23567 CONTINUE
  2093.       CALL ADDCHR(10002, SBUF, SBP, 500)
  2094.       T = LEX(TOKEN)
  2095.       CALL PBSTR(TOKEN)
  2096.       IF(.NOT.(T .NE. 10274))GOTO 23568
  2097.       I = 1
  2098. 23570 IF(.NOT.(I .LT. SBP))GOTO 23572
  2099.       CALL OUTTAB
  2100.       CALL OUTSTR(DAT)
  2101.       K = 1
  2102.       J = I + LENGTH(SBUF(I)) + 1
  2103. 23573 CONTINUE
  2104.       IF(.NOT.(K .GT. 1))GOTO 23576
  2105.       CALL OUTCH(44)
  2106. 23576 CONTINUE
  2107.       CALL OUTSTR(SBUF(I))
  2108.       CALL OUTCH(40)
  2109.       CALL OUTNUM(K)
  2110.       CALL OUTCH(41)
  2111.       CALL OUTCH(47)
  2112.       IF(.NOT.(SBUF(J) .EQ. 10002))GOTO 23578
  2113.       GOTO 23575
  2114. 23578 CONTINUE
  2115.       N = SBUF(J)
  2116.       CALL OUTNUM (N)
  2117.       CALL OUTCH(47)
  2118.       K = K + 1
  2119. 23574 J = J + 1
  2120.       GOTO 23573
  2121. 23575 CONTINUE
  2122.       CALL PBSTR(EOSS)
  2123. 23580 CONTINUE
  2124.       T = GNBTOK(TOKEN, 100)
  2125.       CALL OUTSTR(TOKEN)
  2126. 23581 IF(.NOT.(T .EQ. 47))GOTO 23580
  2127. 23582 CONTINUE
  2128.       CALL OUTDON
  2129. 23571 I = J + 1
  2130.       GOTO 23570
  2131. 23572 CONTINUE
  2132.       SBP = 1
  2133. 23568 CONTINUE
  2134.       RETURN
  2135.       END
  2136.       SUBROUTINE ADDCHR(C, BUF, BP, MAXSIZ)
  2137.       INTEGER BP, MAXSIZ
  2138.       INTEGER C, BUF(100)
  2139.       IF(.NOT.(BP .GT. MAXSIZ))GOTO 23583
  2140.       CALL BADERR(16HBUFFER OVERFLOW.)
  2141. 23583 CONTINUE
  2142.       BUF(BP) = C
  2143.       BP = BP + 1
  2144.       RETURN
  2145.       END
  2146.       INTEGER FUNCTION ALLDIG(STR)
  2147.       INTEGER TYPE
  2148.       INTEGER STR(100)
  2149.       INTEGER I
  2150.       ALLDIG = 0
  2151.       IF(.NOT.(STR(1) .EQ. 10002))GOTO 23585
  2152.       RETURN
  2153. 23585 CONTINUE
  2154.       I = 1
  2155. 23587 IF(.NOT.(STR(I) .NE. 10002))GOTO 23589
  2156.       IF(.NOT.(TYPE(STR(I)) .NE. 2))GOTO 23590
  2157.       RETURN
  2158. 23590 CONTINUE
  2159. 23588 I = I + 1
  2160.       GOTO 23587
  2161. 23589 CONTINUE
  2162.       ALLDIG = 1
  2163.       RETURN
  2164.       END
  2165.       INTEGER FUNCTION LABGEN(N)
  2166.       INTEGER N
  2167.       COMMON /CLABEL/ LABEL
  2168.       INTEGER LABEL
  2169.       LABGEN = LABEL
  2170.       LABEL = LABEL + N
  2171.       RETURN
  2172.       END
  2173.       SUBROUTINE SKPBLK(FD)
  2174.       INTEGER FD
  2175.       INTEGER C, NGETCH
  2176.       C = NGETCH(C, FD)
  2177. 23592 IF(.NOT.(C .EQ. 32 .OR. C .EQ. 9))GOTO 23594
  2178. 23593 C = NGETCH(C, FD)
  2179.       GOTO 23592
  2180. 23594 CONTINUE
  2181.       CALL PUTBAK(C)
  2182.       RETURN
  2183.       END
  2184.       SUBROUTINE CASCOD(LAB, TOKEN)
  2185.       INTEGER LAB, TOKEN
  2186.       INTEGER T, L, LB, UB, I, J, JUNK
  2187.       INTEGER TOK(100)
  2188.       INTEGER CASLAB, LABGEN, GNBTOK
  2189.       COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK(1000)
  2190.       INTEGER SWTOP
  2191.       INTEGER SWLAST
  2192.       INTEGER SWSTAK
  2193.       COMMON /CGOTO/ XFER
  2194.       INTEGER XFER
  2195.       IF(.NOT.(SWTOP .LE. 0))GOTO 23595
  2196.       CALL SYNERR(24HILLEGAL CASE OR DEFAULT.)
  2197.       RETURN
  2198. 23595 CONTINUE
  2199.       CALL OUTGO(LAB+1)
  2200.       XFER = 1
  2201.       L = LABGEN(1)
  2202.       IF(.NOT.(TOKEN .EQ. 10276))GOTO 23597
  2203. 23599 IF(.NOT.(CASLAB(LB, T) .NE. 10003))GOTO 23600
  2204.       UB = LB
  2205.       IF(.NOT.(T .EQ. 45))GOTO 23601
  2206.       JUNK = CASLAB(UB, T)
  2207. 23601 CONTINUE
  2208.       IF(.NOT.(LB .GT. UB))GOTO 23603
  2209.       CALL SYNERR(28HILLEGAL RANGE IN CASE LABEL.)
  2210.       UB = LB
  2211. 23603 CONTINUE
  2212.       IF(.NOT.(SWLAST + 3 .GT. 1000))GOTO 23605
  2213.       CALL BADERR(22HSWITCH TABLE OVERFLOW.)
  2214. 23605 CONTINUE
  2215.       I = SWTOP + 3
  2216. 23607 IF(.NOT.(I .LT. SWLAST))GOTO 23609
  2217.       IF(.NOT.(LB .LE. SWSTAK(I)))GOTO 23610
  2218.       GOTO 23609
  2219. 23610 CONTINUE
  2220.       IF(.NOT.(LB .LE. SWSTAK(I+1)))GOTO 23612
  2221.       CALL SYNERR(21HDUPLICATE CASE LABEL.)
  2222. 23612 CONTINUE
  2223. 23611 CONTINUE
  2224. 23608 I = I + 3
  2225.       GOTO 23607
  2226. 23609 CONTINUE
  2227.       IF(.NOT.(I .LT. SWLAST .AND. UB .GE. SWSTAK(I)))GOTO 23614
  2228.       CALL SYNERR(21HDUPLICATE CASE LABEL.)
  2229. 23614 CONTINUE
  2230.       J = SWLAST
  2231. 23616 IF(.NOT.(J .GT. I))GOTO 23618
  2232.       SWSTAK(J+2) = SWSTAK(J-1)
  2233. 23617 J = J - 1
  2234.       GOTO 23616
  2235. 23618 CONTINUE
  2236.       SWSTAK(I) = LB
  2237.       SWSTAK(I+1) = UB
  2238.       SWSTAK(I+2) = L
  2239.       SWSTAK(SWTOP+1) = SWSTAK(SWTOP+1) + 1
  2240.       SWLAST = SWLAST + 3
  2241.       IF(.NOT.(T .EQ. 58))GOTO 23619
  2242.       GOTO 23600
  2243. 23619 CONTINUE
  2244.       IF(.NOT.(T .NE. 44))GOTO 23621
  2245.       CALL SYNERR(20HILLEGAL CASE SYNTAX.)
  2246. 23621 CONTINUE
  2247. 23620 CONTINUE
  2248.       GOTO 23599
  2249. 23600 CONTINUE
  2250.       GOTO 23598
  2251. 23597 CONTINUE
  2252.       T = GNBTOK(TOK, 100)
  2253.       IF(.NOT.(SWSTAK(SWTOP+2) .NE. 0))GOTO 23623
  2254.       CALL ERROR(38HMULTIPLE DEFAULTS IN SWITCH STATEMENT.)
  2255.       GOTO 23624
  2256. 23623 CONTINUE
  2257.       SWSTAK(SWTOP+2) = L
  2258. 23624 CONTINUE
  2259. 23598 CONTINUE
  2260.       IF(.NOT.(T .EQ. 10003))GOTO 23625
  2261.       CALL SYNERR(15HUNEXPECTED EOF.)
  2262.       GOTO 23626
  2263. 23625 CONTINUE
  2264.       IF(.NOT.(T .NE. 58))GOTO 23627
  2265.       CALL ERROR(39HMISSING COLON IN CASE OR DEFAULT LABEL.)
  2266. 23627 CONTINUE
  2267. 23626 CONTINUE
  2268.       XFER = 0
  2269.       CALL OUTCON(L)
  2270.       RETURN
  2271.       END
  2272.       INTEGER FUNCTION CASLAB(N, T)
  2273.       INTEGER N, T
  2274.       INTEGER TOK(100)
  2275.       INTEGER I, S
  2276.       INTEGER GNBTOK, CTOI
  2277.       T = GNBTOK(TOK, 100)
  2278. 23629 IF(.NOT.(T .EQ. 10))GOTO 23630
  2279.       T = GNBTOK(TOK, 100)
  2280.       GOTO 23629
  2281. 23630 CONTINUE
  2282.       IF(.NOT.(T .EQ. 10003))GOTO 23631
  2283.       CASLAB=(T)
  2284.       RETURN
  2285. 23631 CONTINUE
  2286.       IF(.NOT.(T .EQ. 45))GOTO 23633
  2287.       S = -1
  2288.       GOTO 23634
  2289. 23633 CONTINUE
  2290.       S = +1
  2291. 23634 CONTINUE
  2292.       IF(.NOT.(T .EQ. 45 .OR. T .EQ. 43))GOTO 23635
  2293.       T = GNBTOK(TOK, 100)
  2294. 23635 CONTINUE
  2295.       IF(.NOT.(T .NE. 2))GOTO 23637
  2296.       CALL SYNERR(19HINVALID CASE LABEL.)
  2297.       N = 0
  2298.       GOTO 23638
  2299. 23637 CONTINUE
  2300.       I = 1
  2301.       N = S*CTOI(TOK, I)
  2302. 23638 CONTINUE
  2303.       T = GNBTOK(TOK, 100)
  2304. 23639 IF(.NOT.(T .EQ. 10))GOTO 23640
  2305.       T = GNBTOK(TOK, 100)
  2306.       GOTO 23639
  2307. 23640 CONTINUE
  2308.       RETURN
  2309.       END
  2310.       SUBROUTINE SWCODE(LAB)
  2311.       INTEGER LAB
  2312.       INTEGER TOK(100)
  2313.       INTEGER LABGEN, GNBTOK
  2314.       COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK(1000)
  2315.       INTEGER SWTOP
  2316.       INTEGER SWLAST
  2317.       INTEGER SWSTAK
  2318.       COMMON /CGOTO/ XFER
  2319.       INTEGER XFER
  2320.       LAB = LABGEN(2)
  2321.       IF(.NOT.(SWLAST + 3 .GT. 1000))GOTO 23641
  2322.       CALL BADERR(22HSWITCH TABLE OVERFLOW.)
  2323. 23641 CONTINUE
  2324.       SWSTAK(SWLAST) = SWTOP
  2325.       SWSTAK(SWLAST+1) = 0
  2326.       SWSTAK(SWLAST+2) = 0
  2327.       SWTOP = SWLAST
  2328.       SWLAST = SWLAST + 3
  2329.       XFER = 0
  2330.       CALL OUTTAB
  2331.       CALL SWVAR(LAB)
  2332.       CALL OUTCH(61)
  2333.       CALL BALPAR
  2334.       CALL â•§UTDON
  2335.       CALL OUTGO(LAB)
  2336.       XFER = 1
  2337. 23643 IF(.NOT.(GNBTOK(TOK, 100) .EQ. 10))GOTO 23644
  2338.       GOTO 23643
  2339. 23644 CONTINUE
  2340.       IF(.NOT.(TOK(1) .NE. 123))GOTO 23645
  2341.       CALL SYNERR(39HMISSING LEFT BRACE IN SWITCH STATEMENT.)
  2342.       CALL PBSTR(TOK)
  2343. 23645 CONTINUE
  2344.       RETURN
  2345.       END
  2346.       SUBROUTINE SWEND(LAB)
  2347.       INTEGER LAB
  2348.       INTEGER LB, UB, N, I, J
  2349.       COMMON /CSWTCH/ SWTOP, SWLAST, SWSTAK(1000)
  2350.       INTEGER SWTOP
  2351.       INTEGER SWLAST
  2352.       INTEGER SWSTAK
  2353.       COMMON /CGOTO/ XFER
  2354.       INTEGER XFER
  2355.       INTEGER SIF(4)
  2356.       INTEGER SLT(10)
  2357.       INTEGER SGT(5)
  2358.       INTEGER SGOTO(6)
  2359.       INTEGER SEQ(5)
  2360.       INTEGER SGE(5)
  2361.       INTEGER SLE(5)
  2362.       INTEGER SAND(6)
  2363.       DATA SIF(1)/105/,SIF(2)/102/,SIF(3)/40/,SIF(4)/10002/
  2364.       DATA SLT(1)/46/,SLT(2)/108/,SLT(3)/116/,SLT(4)/46/,SLT(5)/49/,SLT(
  2365.      *6)/46/,SLT(7)/111/,SLT(8)/114/,SLT(9)/46/,SLT(10)/10002/
  2366.       DATA SGT(1)/46/,SGT(2)/103/,SGT(3)/116/,SGT(4)/46/,SGT(5)/10002/
  2367.       DATA SGOTO(1)/103/,SGOTO(2)/111/,SGOTO(3)/116/,SGOTO(4)/111/,SGOTO
  2368.      *(5)/40/,SGOTO(6)/10002/
  2369.       DATA SEQ(1)/46/,SEQ(2)/101/,SEQ(3)/113/,SEQ(4)/46/,SEQ(5)/10002/
  2370.       DATA SGE(1)/46/,SGE(2)/103/,SGE(3)/101/,SGE(4)/46/,SGE(5)/10002/
  2371.       DATA SLE(1)/46/,SLE(2)/108/,SLE(3)/101/,SLE(4)/46/,SLE(5)/10002/
  2372.       DATA SAND(1)/46/,SAND(2)/97/,SAND(3)/110/,SAND(4)/100/,SAND(5)/46/
  2373.      *,SAND(6)/10002/
  2374.       LB = SWSTAK(SWTOP+3)
  2375.       UB = SWSTAK(SWLAST-2)
  2376.       N = SWSTAK(SWTOP+1)
  2377.       CALL OUTGO(LAB+1)
  2378.       IF(.NOT.(SWSTAK(SWTOP+2) .EQ. 0))GOTO 23647
  2379.       SWSTAK(SWTOP+2) = LAB + 1
  2380. 23647 CONTINUE
  2381.       XFER = 0
  2382.       CALL OUTCON(LAB)
  2383.       IF(.NOT.(N .GE. 3 .AND. UB - LB + 1 .LT. 2*N))GOTO 23649
  2384.       IF(.NOT.(LB .NE. 1))GOTO 23651
  2385.       CALL OUTTAB
  2386.       CALL SWVAR(LAB)
  2387.       CALL OUTCH(61)
  2388.       CALL SWVAR(LAB)
  2389.       IF(.NOT.(LB .LT. 1))GOTO 23653
  2390.       CALL OUTCH(43)
  2391. 23653 CONTINUE
  2392.       CALL OUTNUM(-LB + 1)
  2393.       CALL OUTDON
  2394. 23651 CONTINUE
  2395.       CALL OUTTAB
  2396.       CALL OUTSTR(SIF)
  2397.       CALL SWVAR(LAB)
  2398.       CALL OUTSTR(SLT)
  2399.       CALL SWVAR(LAB)
  2400.       CALL OUTSTR(SGT)
  2401.       CALL OUTNUM(UB - LB + 1)
  2402.       CALL OUTCH(41)
  2403.       CALL OUTGO(SWSTAK(SWTOP+2))
  2404.       CALL OUTTAB
  2405.       CALL OUTSTR(SGOTO)
  2406.       J = LB
  2407.       I = SWTOP + 3
  2408. 23655 IF(.NOT.(I .LT. SWLAST))GOTO 23657
  2409. 23658 IF(.NOT.(J .LT. SWSTAK(I)))GOTO 23660
  2410.       CALL OUTNUM(SWSTAK(SWTOP+2))
  2411.       CALL OUTCH(44)
  2412. 23659 J = J + 1
  2413.       GOTO 23658
  2414. 23660 CONTINUE
  2415.       J = SWSTAK(I+1) - SWSTAK(I)
  2416. 23661 IF(.NOT.(J .GE. 0))GOTO 23663
  2417.       CALL OUTNUM(SWSTAK(I+2))
  2418. 23662 J = J - 1
  2419.       GOTO 23661
  2420. 23663 CONTINUE
  2421.       J = SWSTAK(I+1) + 1
  2422.       IF(.NOT.(I .LT. SWLAST - 3))GOTO 23664
  2423.       CALL OUTCH(44)
  2424. 23664 CONTINUE
  2425. 23656 I = I + 3
  2426.       GOTO 23655
  2427. 23657 CONTINUE
  2428.       CALL OUTCH(41)
  2429.       CALL OUTCH(44)
  2430.       CALL SWVAR(LAB)
  2431.       CALL OUTDON
  2432.       GOTO 23650
  2433. 23649 CONTINUE
  2434.       IF(.NOT.(N .GT. 0))GOTO 23666
  2435.       I = SWTOP + 3
  2436. 23668 IF(.NOT.(I .LT. SWLAST))GOTO 23670
  2437.       CALL OUTTAB
  2438.       CALL OUTSTR(SIF)
  2439.       CALL SWVAR(LAB)
  2440.       IF(.NOT.(SWSTAK(I) .EQ. SWSTAK(I+1)))GOTO 23671
  2441.       CALL OUTSTR(SEQ)
  2442.       CALL OUTNUM(SWSTAK(I))
  2443.       GOTO 23672
  2444. 23671 CONTINUE
  2445.       CALL OUTSTR(SGE)
  2446.       CALL OUTNUM(SWSTAK(I))
  2447.       CALL OUTSTR(SAND)
  2448.       CALL SWVAR(LAB)
  2449.       CALL OUTSTR(SLE)
  2450.       CALL OUTNUM(SWSTAK(I+1))
  2451. 23672 CONTINUE
  2452.       CALL OUTCH(41)
  2453.       CALL OUTGO(SWSTAK(I+2))
  2454. 23669 I = I + 3
  2455.       GOTO 23668
  2456. 23670 CONTINUE
  2457.       IF(.NOT.(LAB + 1 .NE. SWSTAK(SWTOP+2)))GOTO 23673
  2458.       CALL OUTGO(SWSTAK(SWTOP+2))
  2459. 23673 CONTINUE
  2460. 23666 CONTINUE
  2461. 23650 CONTINUE
  2462.       CALL OUTCON(LAB+1)
  2463.       SWLAST = SWTOP
  2464.       SWTOP = SWSTAK(SWTOP)
  2465.       RETURN
  2466.       END
  2467.       SUBROUTINE SWVAR(LAB)
  2468.       INTEGER LAB
  2469.       CALL OUTCH(73)
  2470.       CALL OUTNUM(LAB)
  2471.       RETURN
  2472.       END
  2473.       SUBROUTINE WHILEC(LAB)
  2474.       INTEGER LABGEN
  2475.       INTEGER LAB
  2476.       CALL OUTCON(0)
  2477.       LAB = LABGEN(2)
  2478.       CALL OUTNUM(LAB)
  2479.       CALL IFGO(LAB+1)
  2480.       RETURN
  2481.       END
  2482.       SUBROUTINE WHILES(LAB)
  2483.       INTEGER LAB
  2484.       CALL OUTGO(LAB)
  2485.       CALL OUTCON(LAB+1)
  2486.       RETURN
  2487.       END
  2488.       INTEGER FUNCTION ADDSET (C, STR, J, MAXSIZ)
  2489.       INTEGER J, MAXSIZ
  2490.       INTEGER C, STR(MAXSIZ)
  2491.       IF(.NOT.(J .GT. MAXSIZ))GOTO 23000
  2492.       ADDSET = 0
  2493.       GOTO 23001
  2494. 23000 CONTINUE
  2495.       STR(J) = C
  2496.       J = J + 1
  2497.       ADDSET = 1
  2498. 23001 CONTINUE
  2499.       RETURN
  2500.       END
  2501.       INTEGER FUNCTION ADDSTR(S, STR, J, MAXSIZ)
  2502.       INTEGER S(100), STR(100)
  2503.       INTEGER J, MAXSIZ
  2504.       INTEGER I, ADDSET
  2505.       I = 1
  2506. 23002 IF(.NOT.(S(I) .NE. 10002))GOTO 23004
  2507.       IF(.NOT.(ADDSET(S(I), STR, J, MAXSIZ) .EQ. 0))GOTO 23005
  2508.       ADDSTR = 0
  2509.       RETURN
  2510. 23005 CONTINUE
  2511. 23003 I = I + 1
  2512.       GOTO 23002
  2513. 23004 CONTINUE
  2514.       ADDSTR = 1
  2515.       RETURN
  2516.       END
  2517.       SUBROUTINE CANT (FILE)
  2518.       INTEGER FILE (100)
  2519.       INTEGER BUF(15)
  2520.       DATA BUF(1), BUF(2), BUF(3), BUF(4), BUF(5), BUF(6), BUF(7), BUF(8
  2521.      *), BUF(9), BUF(10), BUF(11), BUF(12), BUF(13), BUF(14), BUF(15) /5
  2522.      *8, 32, 32, 99, 97, 110, 39, 116, 32, 111, 112, 101, 110, 10, 10002
  2523.      */
  2524.       CALL PUTLIN (FILE, 3)
  2525.       CALL PUTLIN (BUF, 3)
  2526.       CALL ENDST
  2527.       END
  2528.       INTEGER FUNCTION CLOWER(C)
  2529.       INTEGER C, K
  2530.       IF(.NOT.(C .GE. 65 .AND. C .LE. 90))GOTO 23007
  2531.       K = 97 - 65
  2532.       CLOWER = C + K
  2533.       GOTO 23008
  2534. 23007 CONTINUE
  2535.       CLOWER = C
  2536. 23008 CONTINUE
  2537.       RETURN
  2538.       END
  2539.       SUBROUTINE CONCAT (BUF1, BUF2, OUTSTR)
  2540.       INTEGER BUF1(100), BUF2(100), OUTSTR(100)
  2541.       INTEGER LEN, I, J
  2542.       INTEGER LENGTH
  2543.       CALL SCOPY(BUF1, 1, OUTSTR, 1)
  2544.       LEN = LENGTH(OUTSTR)
  2545.       J = 1
  2546.       I=LEN+1
  2547. 23009 IF(.NOT.(BUF2(J) .NE. 10002))GOTO 23011
  2548.       CALL SCOPY(BUF2, J, OUTSTR, I)
  2549.       J = J + 1
  2550. 23010 I=I+1
  2551.       GOTO 23009
  2552. 23011 CONTINUE
  2553.       OUTSTR(I) = 10002
  2554.       RETURN
  2555.       END
  2556.       INTEGER FUNCTION CTOI(IN, I)
  2557.       INTEGER IN(100)
  2558.       INTEGER INDEX
  2559.       INTEGER D, I
  2560.       INTEGER DIGITS(11)
  2561.       DATA DIGITS(1) /48/
  2562.       DATA DIGITS(2) /49/
  2563.       DATA DIGITS(3) /50/
  2564.       DATA DIGITS(4) /51/
  2565.       DATA DIGITS(5) /52/
  2566.       DATA DIGITS(6) /53/
  2567.       DATA DIGITS(7) /54/
  2568.       DATA DIGITS(8) /55/
  2569.       DATA DIGITS(9) /56/
  2570.       DATA DIGITS(10) /57/
  2571.       DATA DIGITS(11) /10002/
  2572. 23012 IF(.NOT.(IN(I) .EQ. 32 .OR. IN(I) .EQ. 9))GOTO 23013
  2573.       I = I + 1
  2574.       GOTO 23012
  2575. 23013 CONTINUE
  2576.       CTOI = 0
  2577. 23014 IF(.NOT.(IN(I) .NE. 10002))GOTO 23016
  2578.       D = INDEX(DIGITS, IN(I))
  2579.       IF(.NOT.(D .EQ. 0))GOTO 23017
  2580.       GOTO 23016
  2581. 23017 CONTINUE
  2582.       CTOI = 10 * CTOI + D - 1
  2583. 23015 I = I + 1
  2584.       GOTO 23014
  2585. 23016 CONTINUE
  2586.       RETURN
  2587.       END
  2588.       INTEGER FUNCTION CUPPER(C)
  2589.       INTEGER C, K
  2590.       IF(.NOT.(C .GE. 97 .AND. C .LE. 122))GOTO 23019
  2591.       CUPPER = C + (65 - 97)
  2592.       GOTO 23020
  2593. 23019 CONTINUE
  2594.       CUPPER = C
  2595. 23020 CONTINUE
  2596.       RETURN
  2597.       END
  2598.       INTEGER FUNCTION EQUAL (STR1, STR2)
  2599.       INTEGER STR1(100), STR2(100)
  2600.       INTEGER I
  2601.       I=1
  2602. 23021 IF(.NOT.(STR1(I) .EQ. STR2(I)))GOTO 23023
  2603.       IF(.NOT.(STR1(I) .EQ. 10002))GOTO 23024
  2604.       EQUAL = 1
  2605.       RETURN
  2606. 23024 CONTINUE
  2607. 23022 I=I+1
  2608.       GOTO 23021
  2609. 23023 CONTINUE
  2610.       EQUAL = 0
  2611.       RETURN
  2612.       END
  2613.       SUBROUTINE ERROR (LINE)
  2614.       INTEGER LINE(100)
  2615.       CALL REMARK (LINE)
  2616.       CALL ENDST
  2617.       END
  2618.       INTEGER FUNCTION ESC (ARRAY, I)
  2619.       INTEGER ARRAY(100)
  2620.       INTEGER I
  2621.       IF(.NOT.(ARRAY(I) .NE. 64))GOTO 23026
  2622.       ESC = ARRAY(I)
  2623.       GOTO 23027
  2624. 23026 CONTINUE
  2625.       IF(.NOT.(ARRAY(I+1) .EQ. 10002))GOTO 23028
  2626.       ESC = 64
  2627.       GOTO 23029
  2628. 23028 CONTINUE
  2629.       I = I + 1
  2630.       IF(.NOT.(ARRAY(I) .EQ. 110 .OR. ARRAY(I) .EQ. 78))GOTO 23030
  2631.       ESC = 10
  2632.       GOTO 23031
  2633. 23030 CONTINUE
  2634.       IF(.NOT.(ARRAY(I) .EQ. 116 .OR. ARRAY(I) .EQ. 84))GOTO 23032
  2635.       ESC = 9
  2636.       GOTO 23033
  2637. 23032 CONTINUE
  2638.       ESC = ARRAY(I)
  2639. 23033 CONTINUE
  2640. 23031 CONTINUE
  2641. 23029 CONTINUE
  2642. 23027 CONTINUE
  2643.       RETURN
  2644.       END
  2645.       SUBROUTINE FCOPY (IN, OUT)
  2646.       INTEGER C
  2647.       INTEGER GETCH
  2648.       INTEGER IN, OUT
  2649. 23034 IF(.NOT.(GETCH(C,IN) .NE. 10003))GOTO 23035
  2650.       CALL PUTCH(C, OUT)
  2651.       GOTO 23034
  2652. 23035 CONTINUE
  2653.       RETURN
  2654.       END
  2655.       SUBROUTINE FOLD (TOKEN)
  2656.       INTEGER TOKEN(100), CLOWER
  2657.       INTEGER I
  2658.       I=1
  2659. 23036 IF(.NOT.(TOKEN(I) .NE. 10002))GOTO 23038
  2660.       TOKEN(I) = CLOWER(TOKEN(I))
  2661. 23037 I=I+1
  2662.       GOTO 23036
  2663. 23038 CONTINUE
  2664.       RETURN
  2665.       END
  2666.       INTEGER FUNCTION GETC(C)
  2667.       INTEGER C
  2668.       INTEGER GETCH
  2669.       GETC = GETCH(C, 1)
  2670.       RETURN
  2671.       END
  2672.       INTEGER FUNCTION GETWRD (IN, I, OUT)
  2673.       INTEGER IN(100), OUT(100)
  2674.       INTEGER I, J
  2675. 23039 IF(.NOT.(IN(I) .EQ. 32 .OR. IN(I) .EQ. 9))GOTO 23040
  2676.       I = I + 1
  2677.       GOTO 23039
  2678. 23040 CONTINUE
  2679.       J = 1
  2680. 23041 IF(.NOT.(IN(I) .NE. 10002 .AND. IN(I) .NE. 32 .AND. IN(I) .NE. 9 .
  2681.      *AND. IN(I) .NE. 10))GOTO 23042
  2682.       OUT(J) = IN(I)
  2683.       I = I + 1
  2684.       J = J + 1
  2685.       GOTO 23041
  2686. 23042 CONTINUE
  2687.       OUT(J) = 10002
  2688.       GETWRD = J - 1
  2689.       RETURN
  2690.       END
  2691.       INTEGER FUNCTION INDEX(STR, C)
  2692.       INTEGER C, STR(100)
  2693.       INDEX = 1
  2694. 23043 IF(.NOT.(STR(INDEX) .NE. 10002))GOTO 23045
  2695.       IF(.NOT.(STR(INDEX) .EQ. C))GOTO 23046
  2696.       RETURN
  2697. 23046 CONTINUE
  2698. 23044 INDEX = INDEX + 1
  2699.       GOTO 23043
  2700. 23045 CONTINUE
  2701.       INDEX = 0
  2702.       RETURN
  2703.       END
  2704.       INTEGER FUNCTION ITOC(INT, STR, SIZE)
  2705.       INTEGER MOD
  2706.       INTEGER D, I, INT, INTVAL, J, K, SIZE
  2707.       INTEGER STR(SIZE)
  2708.       INTEGER DIGITS(11)
  2709.       DATA DIGITS(1) /48/
  2710.       DATA DIGITS(2) /49/
  2711.       DATA DIGITS(3) /50/
  2712.       DATA DIGITS(4) /51/
  2713.       DATA DIGITS(5) /52/
  2714.       DATA DIGITS(6) /53/
  2715.       DATA DIGITS(7) /54/
  2716.       DATA DIGITS(8) /55/
  2717.       DATA DIGITS(9) /56/
  2718.       DATA DIGITS(10) /57/
  2719.       DATA DIGITS(11) /10002/
  2720.       INTVAL = IABS(INT)
  2721.       STR(1) = 10002
  2722.       I = 1
  2723. 23048 CONTINUE
  2724.       I = I + 1
  2725.       D = MOD(INTVAL, 10)
  2726.       STR(I) = DIGITS(D+1)
  2727.       INTVAL = INTVAL / 10
  2728. 23049 IF(.NOT.(INTVAL .EQ. 0 .OR. I .GE. SIZE))GOTO 23048
  2729. 23050 CONTINUE
  2730.       IF(.NOT.(INT .LT. 0 .AND. I .LT. SIZE))GOTO 23051
  2731.       I = I + 1
  2732.       STR(I) = 45
  2733. 23051 CONTINUE
  2734.       ITOC = I - 1
  2735.       J = 1
  2736. 23053 IF(.NOT.(J .LT. I))GOTO 23055
  2737.       K = STR(I)
  2738.       STR(I) = STR(J)
  2739.       STR(J) = K
  2740.       I = I - 1
  2741. 23054 J = J + 1
  2742.       GOTO 23053
  2743. 23055 CONTINUE
  2744.       RETURN
  2745.       END
  2746.       INTEGER FUNCTION LENGTH (STR)
  2747.       INTEGER STR(100)
  2748.       LENGTH=0
  2749. 23056 IF(.NOT.(STR(LENGTH+1) .NE. 10002))GOTO 23058
  2750. 23057 LENGTH = LENGTH + 1
  2751.       GOTO 23056
  2752. 23058 CONTINUE
  2753.       RETURN
  2754.       END
  2755.       SUBROUTINE LOWER (TOKEN)
  2756.       INTEGER TOKEN(100)
  2757.       CALL FOLD(TOKEN)
  2758.       RETURN
  2759.       END
  2760.       SUBROUTINE PUTC (C)
  2761.       INTEGER C
  2762.       CALL PUTCH (C, 2)
  2763.       RETURN
  2764.       END
  2765.       SUBROUTINE PUTDEC(N,W)
  2766.       INTEGER CHARS(120)
  2767.       INTEGER ITOC
  2768.       INTEGER I,N,ND,W
  2769.       ND = ITOC(N,CHARS,20)
  2770.       I = ND+1
  2771. 23059 IF(.NOT.(I .LE. W))GOTO 23061
  2772.       CALL PUTC(32)
  2773. 23060 I = I+1
  2774.       GOTO 23059
  2775. 23061 CONTINUE
  2776.       I = 1
  2777. 23062 IF(.NOT.(I .LE. ND))GOTO 23064
  2778.       CALL PUTC(CHARS(I))
  2779. 23063 I = I+1
  2780.       GOTO 23062
  2781. 23064 CONTINUE
  2782.       RETURN
  2783.       END
  2784.       SUBROUTINE PUTINT(N, W, FD)
  2785.       INTEGER CHARS(20)
  2786.       INTEGER ITOC
  2787.       INTEGER N, W, FD, JUNK
  2788.       JUNK = ITOC(N,CHARS,20)
  2789.       CALL PUTSTR(CHARS, W, FD)
  2790.       RETURN
  2791.       END
  2792.       SUBROUTINE PUTSTR(STR, W, FD)
  2793.       INTEGER STR(100)
  2794.       INTEGER W, FD
  2795.       INTEGER LEN, I
  2796.       INTEGER LENGTH
  2797.       LEN = LENGTH(STR)
  2798.       I = LEN+1
  2799. 23065 IF(.NOT.(I .LE. W))GOTO 23067
  2800.       CALL PUTCH(32, FD)
  2801. 23066 I=I+1
  2802.       GOTO 23065
  2803. 23067 CONTINUE
  2804.       I = 1
  2805. 23068 IF(.NOT.(I .LE. LEN))GOTO 23070
  2806.       CALL PUTCH(STR(I), FD)
  2807. 23069 I=I+1
  2808.       GOTO 23068
  2809. 23070 CONTINUE
  2810.       I = (-W) - LEN
  2811. 23071 IF(.NOT.(I .GT. 0))GOTO 23073
  2812.       CALL PUTCH(32, FD)
  2813. 23072 I = I - 1
  2814.       GOTO 23071
  2815. 23073 CONTINUE
  2816.       RETURN
  2817.       END
  2818.       SUBROUTINE SCOPY(FROM, I, TO, J)
  2819.       INTEGER FROM(100), TO(100)
  2820.       INTEGER I, J, K1, K2
  2821.       K2 = J
  2822.       K1 = I
  2823. 23074 IF(.NOT.(FROM(K1) .NE. 10002))GOTO 23076
  2824.       TO(K2) = FROM(K1)
  2825.       K2 = K2 + 1
  2826. 23075 K1 = K1 + 1
  2827.       GOTO 23074
  2828. 23076 CONTINUE
  2829.       TO(K2) = 10002
  2830.       RETURN
  2831.       END
  2832.       SUBROUTINE SKIPBL(LIN, I)
  2833.       INTEGER LIN(100)
  2834.       INTEGER I
  2835. 23077 IF(.NOT.(LIN(I) .EQ. 32 .OR. LIN(I) .EQ. 9))GOTO 23078
  2836.       I = I + 1
  2837.       GOTO 23077
  2838. 23078 CONTINUE
  2839.       RETURN
  2840.       END
  2841.       SUBROUTINE STCOPY(IN, I, OUT, J)
  2842.       INTEGER IN(100), OUT(100)
  2843.       INTEGER I, J, K
  2844.       K=I
  2845. 23079 IF(.NOT.(IN(K) .NE. 10002))GOTO 23081
  2846.       OUT(J) = IN(K)
  2847.       J = J + 1
  2848. 23080 K=K+1
  2849.       GOTO 23079
  2850. 23081 CONTINUE
  2851.       RETURN
  2852.       END
  2853.       INTEGER FUNCTION STRCMP (STR1, STR2)
  2854.       INTEGER STR1(100), STR2(100)
  2855.       INTEGER I
  2856.       I=1
  2857. 23082 IF(.NOT.(STR1(I) .EQ. STR2(I)))GOTO 23084
  2858.       IF(.NOT.(STR1(I) .EQ. 10002))GOTO 23085
  2859.       STRCMP = 0
  2860.       RETURN
  2861. 23085 CONTINUE
  2862. 23083 I=I+1
  2863.       GOTO 23082
  2864. 23084 CONTINUE
  2865.       IF(.NOT.(STR1(I) .EQ. 10002))GOTO 23087
  2866.       STRCMP = -1
  2867.       GOTO 23088
  2868. 23087 CONTINUE
  2869.       IF(.NOT.(STR2(I) .EQ. 10002))GOTO 23089
  2870.       STRCMP = + 1
  2871.       GOTO 23090
  2872. 23089 CONTINUE
  2873.       IF(.NOT.(STR1(I) .LT. STR2(I)))GOTO 23091
  2874.       STRCMP = -1
  2875.       GOTO 23092
  2876. 23091 CONTINUE
  2877.       STRCMP = +1
  2878. 23092 CONTINUE
  2879. 23090 CONTINUE
  2880. 23088 CONTINUE
  2881.       RETURN
  2882.       END
  2883.       INTEGER FUNCTION TYPE (C)
  2884.       INTEGER C
  2885.       IF(.NOT.( (C .GE. 97 .AND. C .LE. 122) .OR. ( C .GE. 65 .AND. C .L
  2886.      *E. 90)))GOTO 23093
  2887.       TYPE = 1
  2888.       GOTO 23094
  2889. 23093 CONTINUE
  2890.       IF(.NOT.(C .GE. 48 .AND. C .LE. 57))GOTO 23095
  2891.       TYPE = 2
  2892.       GOTO 23096
  2893. 23095 CONTINUE
  2894.       TYPE = C
  2895. 23096 CONTINUE
  2896. 23094 CONTINUE
  2897.       RETURN
  2898.       END
  2899.       SUBROUTINE UPPER (TOKEN)
  2900.       INTEGER TOKEN(100), CUPPER
  2901.       INTEGER I
  2902.       I=1
  2903. 23097 IF(.NOT.(TOKEN(I) .NE. 10002))GOTO 23099
  2904.       TOKEN(I) = CUPPER(TOKEN(I))
  2905. 23098 I=I+1
  2906.       GOTO 23097
  2907. 23099 CONTINUE
  2908.       RETURN
  2909.       END
  2910.       SUBROUTINE INSTAL(NAME, DEFN)
  2911.       INTEGER NAME(100), DEFN(100)
  2912.       INTEGER NLEN, DLEN, LENGTH, C, HSHFCN
  2913.       COMMON /CLOOK/ LASTP, LASTT, HSHPTR(37), TABPTR(2,625), TABLE(6250
  2914.      *)
  2915.       INTEGER LASTP
  2916.       INTEGER LASTT
  2917.       INTEGER HSHPTR
  2918.       INTEGER TABPTR
  2919.       INTEGER TABLE
  2920.       NLEN = LENGTH(NAME) + 1
  2921.       DLEN = LENGTH(DEFN) + 1
  2922.       IF(.NOT.(LASTT + NLEN + DLEN .GT. 6250 .OR. LASTP .GE. 625))GOTO 2
  2923.      *3100
  2924.       CALL PUTLIN(NAME, 3)
  2925.       CALL REMARK(24H : TOO MANY DEFINITIONS.)
  2926.       GOTO 23101
  2927. 23100 CONTINUE
  2928.       LASTP = LASTP + 1
  2929.       TABPTR(2, LASTP) = LASTT + 1
  2930.       C = HSHFCN(NAME, 37)
  2931.       TABPTR(1, LASTP) = HSHPTR(C)
  2932.       HSHPTR(C) = LASTP
  2933.       CALL SCOPY(NAME, 1, TABLE, LASTT + 1)
  2934.       CALL SCOPY(DEFN, 1, TABLE, LASTT + NLEN + 1)
  2935.       LASTT = LASTT + NLEN + DLEN
  2936. 23101 CONTINUE
  2937.       RETURN
  2938.       END
  2939.       INTEGER FUNCTION LOOKUP(NAME, DEFN)
  2940.       INTEGER NAME(100), DEFN(100)
  2941.       INTEGER C, HSHFCN, I, J, K
  2942.       COMMON /CLOOK/ LASTP, LASTT, HSHPTR(37), TABPTR(2,625), TABLE(6250
  2943.      *)
  2944.       INTEGER LASTP
  2945.       INTEGER LASTT
  2946.       INTEGER HSHPTR
  2947.       INTEGER TABPTR
  2948.       INTEGER TABLE
  2949.       C = HSHFCN(NAME, 37)
  2950.       LOOKUP = 0
  2951.       I=HSHPTR(C)
  2952. 23102 IF(.NOT.(I .GT. 0))GOTO 23104
  2953.       J = TABPTR(2, I)
  2954.       K=1
  2955. 23105 IF(.NOT.(NAME(K) .EQ. TABLE(J) .AND. NAME(K) .NE. 10002))GOTO 2310
  2956.      *7
  2957.       J = J + 1
  2958. 23106 K=K+1
  2959.       GOTO 23105
  2960. 23107 CONTINUE
  2961.       IF(.NOT.(NAME(K) .EQ. TABLE(J)))GOTO 23108
  2962.       CALL SCOPY(TABLE, J+1, DEFN, 1)
  2963.       LOOKUP = 1
  2964.       GOTO 23104
  2965. 23108 CONTINUE
  2966. 23103 I=TABPTR(1,I)
  2967.       GOTO 23102
  2968. 23104 CONTINUE
  2969.       RETURN
  2970.       END
  2971.       INTEGER FUNCTION HSHFCN(STRNG, N)
  2972.       INTEGER STRNG(100)
  2973.       INTEGER N, I, LENGTH, I1, I2
  2974.       I = LENGTH(STRNG)
  2975.       I = MAX0(I, 1)
  2976.       I1 = STRNG(1)
  2977.       I2 = STRNG(I)
  2978.       HSHFCN = MOD(I1+I2, N) + 1
  2979.       RETURN
  2980.       END
  2981.       SUBROUTINE TBINIT
  2982.       COMMON /CLOOK/ LASTP, LASTT, HSHPTR(37), TABPTR(2,625), TABLE(6250
  2983.      *)
  2984.       INTEGER LASTP
  2985.       INTEGER LASTT
  2986.       INTEGER HSHPTR
  2987.       INTEGER TABPTR
  2988.       INTEGER TABLE
  2989.       INTEGER I
  2990.       LASTP = 0
  2991.       LASTT = 0
  2992.       I=1
  2993. 23110 IF(.NOT.(I.LE.37))GOTO 23112
  2994.       HSHPTR(I) = 0
  2995. 23111 I=I+1
  2996.       GOTO 23110
  2997. 23112 CONTINUE
  2998.       RETURN
  2999.       END
  3000.       INTEGER FUNCTION OPEN(NAME, ACCESS)
  3001.       INTEGER NAME(100)
  3002.       INTEGER ACCESS
  3003.       OPEN = 10001
  3004.       RETURN
  3005.       END
  3006.       SUBROUTINE CLOSE(FD)
  3007.       INTEGER FD
  3008.       RETURN
  3009.       END
  3010.       SUBROUTINE INITST
  3011.       RETURN
  3012.       END
  3013.       SUBROUTINE ENDST
  3014.       STOP
  3015.       END
  3016.       INTEGER FUNCTION GETARG(N, BUF, MAXSIZ)
  3017.       INTEGER N, MAXSIZ
  3018.       INTEGER BUF(100)
  3019.       GETARG = 10003
  3020.       RETURN
  3021.       END
  3022.       SUBROUTINE PUTLIN(LIN, FD)
  3023.       INTEGER LIN(100)
  3024.       INTEGER FD
  3025.       INTEGER I
  3026.       I=1
  3027. 23113 IF(.NOT.(LIN(I) .NE. 10002))GOTO 23115
  3028.       CALL PUTCH(LIN(I), FD)
  3029. 23114 I=I+1
  3030.       GOTO 23113
  3031. 23115 CONTINUE
  3032.       RETURN
  3033.       END
  3034.  
  3035.  
  3036.  
  3037.  
  3038.  
  3039.  
  3040.  
  3041.  
  3042.  
  3043.  
  3044.  
  3045.  
  3046.  
  3047.  
  3048.  
  3049.  
  3050.  
  3051.